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 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 __PACKAGE__->register_method (
  46         method   => 'patron_penalty',
  47         api_name         => 'open-ils.penalty.patron_penalty.calculate',
  48         signature => q/
  49                 Calculates the patron's standing penalties
  50                 @param args An object of named params including:
  51                         patronid The id of the patron
  52                         update True if this call should update the database
  53                         background True if this call should return immediately,
  54                                 then go on to process the penalties.  This flag
  55                                 works only in conjunction with the 'update' flag.
  56                 @return An object with keys 'fatal_penalties' and
  57                 'info_penalties' who are themeselves arrays of 0 or
  58                 more penalties.  Returns event on error.
  59         /
  60 );
  61
  62 # --------------------------------------------------------------
  63 # modes:
  64 #  - update
  65 #  - background : modifier to 'update' which says to return
  66 #               immediately then continue processing.  If this flag is set
  67 #               then the caller will get no penalty info and will never
  68 #               know for sure if the call even succeeded.
  69 # --------------------------------------------------------------
  70 sub patron_penalty {
  71         my( $self, $conn, $args ) = @_;
  72
  73         my( $patron, $evt );
  74
  75         $conn->respond_complete(1) if $$args{background};
  76
  77         return { fatal_penalties => [], info_penalties => [] }
  78                 unless ($args->{patron} || $args->{patronid});
  79
  80         $args->{patron_id} = $args->{patronid};
  81         $args->{fetch_patron_circ_info} = 1;
  82         my $runner = OpenILS::Application::Circ::ScriptBuilder->build($args);
  83
  84         # - Load up the script and run it
  85         $runner->add_path($path);
  86
  87         $runner->run($script) or
  88                 throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
  89
  90         # array items are returned as a comma-separated list of strings
  91         my @fatals = split( /,/, $runner->retrieve($fatal_key) );
  92         my @infos = split( /,/, $runner->retrieve($info_key) );
  93         my $all = [ @fatals, @infos ];
  94
  95         $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
  96
  97         $conn->respond_complete(
  98                 { fatal_penalties => \@fatals, info_penalties => \@infos });
  99
 100         # - update the penalty info in the db if necessary
 101         $evt = update_patron_penalties(
 102                 patron    => $patron,
 103                 penalties => $all ) if $$args{update};
 104
 105         # - The caller won't know it failed, so log it
 106         $logger->error("penalty: Error updating the patron ".
 107                 "penalties in the database: ".Dumper($evt)) if $evt;
 108
 109         return undef;
 110 }
 111
 112 # --------------------------------------------------------------
 113 # Removes existing penalties for the patron that are not passed
 114 # into this function.  Creates new penalty entries for the
 115 # provided penalties that don't already exist;
 116 # --------------------------------------------------------------
 117 sub update_patron_penalties {
 118
 119         my %args      = @_;
 120         my $patron    = $args{patron};
 121         my $penalties = $args{penalties};
 122
 123         my $session   = $U->start_db_session();
 124         my $pid = ($patron) ? $patron->id : $args{patronid};
 125
 126         # - fetch the current penalties
 127         my $existing = $session->request(
 128                 'open-ils.storage.direct.actor.'.
 129                 'user_standing_penalty.search.usr.atomic', $pid )->gather(1);
 130
 131         my @deleted;
 132
 133         # If an existing penalty is not in the newly generated
 134         # list of penalties, remove it from the DB
 135         for my $e (@$existing) {
 136                 if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
 137
 138                         $logger->activity("penalty: removing user penalty ".
 139                                 $e->penalty_type . " from user $pid");
 140
 141                         my $s = $session->request(
 142                                 'open-ils.storage.direct.actor.user_standing_penalty.delete', $e->id )->gather(1);
 143                         return $U->DB_UPDATE_FAILED($e) unless defined($s);
 144                 }
 145         }
 146
 147         # Add penalties that previously didn't exist
 148         for my $p (@$penalties) {
 149                 if( ! grep { $_->penalty_type eq $p } @$existing ) {
 150
 151                         $logger->activity("penalty: adding user penalty $p to user $pid");
 152
 153                         my $newp = Fieldmapper::actor::user_standing_penalty->new;
 154                         $newp->penalty_type( $p );
 155                         $newp->usr( $pid );
 156
 157                         my $s = $session->request(
 158                                 'open-ils.storage.direct.actor.user_standing_penalty.create', $newp )->gather(1);
 159                         return $U->DB_UPDATE_FAILED($p) unless $s;
 160                 }
 161         }
 162
 163         $U->commit_db_session($session);
 164         return undef;
 165 }
 166
 167
 168
 169
 170
 171 1;