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->load($script);
  88         my $result = $runner->run or throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
  89
  90         my @fatals = @{$result->{fatalEvents}};
  91         my @infos = @{$result->{infoEvents}};
  92         my $all = [ @fatals, @infos ];
  93
  94         $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
  95
  96         $conn->respond_complete(
  97                 { fatal_penalties => \@fatals, info_penalties => \@infos });
  98
  99         # - update the penalty info in the db if necessary
 100         $logger->debug("update penalty settings = " . $$args{update});
 101
 102         $evt = update_patron_penalties(
 103                 patron    => $args->{patron},
 104                 penalties => $all ) if $$args{update};
 105
 106         # - The caller won't know it failed, so log it
 107         $logger->error("penalty: Error updating the patron ".
 108                 "penalties in the database: ".Dumper($evt)) if $evt;
 109
 110         return undef;
 111 }
 112
 113 # --------------------------------------------------------------
 114 # Removes existing penalties for the patron that are not passed
 115 # into this function.  Creates new penalty entries for the
 116 # provided penalties that don't already exist;
 117 # --------------------------------------------------------------
 118 sub update_patron_penalties {
 119
 120         my %args      = @_;
 121         my $patron    = $args{patron};
 122         my $penalties = $args{penalties};
 123         my $pid = $patron->id;
 124
 125         $logger->debug("updating penalties for patron $pid => @$penalties");
 126
 127         my $session   = $U->start_db_session();
 128
 129         # - fetch the current penalties
 130         my $existing = $session->request(
 131                 'open-ils.storage.direct.actor.'.
 132                 'user_standing_penalty.search.usr.atomic', $pid )->gather(1);
 133
 134         my @types;
 135         push( @types, $_->penalty_type ) for @$existing;
 136         $logger->info("penalty: user has existing penalties [@types]");
 137
 138         my @deleted;
 139
 140         # If an existing penalty is not in the newly generated
 141         # list of penalties, remove it from the DB
 142         for my $e (@$existing) {
 143                 if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
 144
 145                         $logger->activity("penalty: removing user penalty ".
 146                                 $e->penalty_type . " from user $pid");
 147
 148                         my $s = $session->request(
 149                                 'open-ils.storage.direct.actor.user_standing_penalty.delete', $e->id )->gather(1);
 150                         return $U->DB_UPDATE_FAILED($e) unless defined($s);
 151                 }
 152         }
 153
 154         # Add penalties that previously didn't exist
 155         for my $p (@$penalties) {
 156                 if( ! grep { $_->penalty_type eq $p } @$existing ) {
 157
 158                         $logger->activity("penalty: adding user penalty $p to user $pid");
 159
 160                         my $newp = Fieldmapper::actor::user_standing_penalty->new;
 161                         $newp->penalty_type( $p );
 162                         $newp->usr( $pid );
 163
 164                         my $s = $session->request(
 165                                 'open-ils.storage.direct.actor.user_standing_penalty.create', $newp )->gather(1);
 166                         return $U->DB_UPDATE_FAILED($p) unless $s;
 167                 }
 168         }
 169
 170         $U->commit_db_session($session);
 171         return undef;
 172 }
 173
 174
 175
 176
 177
 178 1;