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 OpenILS::Utils::CStoreEditor qw/:funcs/;
  13 use base 'OpenSRF::Application';
  14
  15 my $U = "OpenILS::Application::AppUtils";
  16 my $script;
  17 my $path;
  18 my $libs;
  19 my $runner;
  20 my %groups; # - user groups
  21
  22 my $fatal_key = 'result.fatalEvents';
  23 my $info_key = 'result.infoEvents';
  24
  25
  26 # --------------------------------------------------------------
  27 # Loads the config info
  28 # --------------------------------------------------------------
  29 sub initialize {
  30
  31         my $conf = OpenSRF::Utils::SettingsClient->new;
  32         my @pfx  = ( "apps", "open-ils.penalty","app_settings" );
  33         $path           = $conf->config_value( @pfx, 'script_path');
  34         $script = $conf->config_value( @pfx, 'patron_penalty' );
  35
  36         $path = (ref($path)) ? $path : [$path];
  37
  38         if(!($path and $script)) {
  39                 $logger->error("penalty:  server config missing script and/or script path");
  40                 return 0;
  41         }
  42
  43         $logger->info("penalty: Loading patron penalty script $script with paths @$path");
  44 }
  45
  46
  47
  48 __PACKAGE__->register_method (
  49         method   => 'patron_penalty',
  50         api_name         => 'open-ils.penalty.patron_penalty.calculate',
  51         signature => q/
  52                 Calculates the patron's standing penalties
  53                 @param args An object of named params including:
  54                         patronid The id of the patron
  55                         update True if this call should update the database
  56                         background True if this call should return immediately,
  57                                 then go on to process the penalties.  This flag
  58                                 works only in conjunction with the 'update' flag.
  59                 @return An object with keys 'fatal_penalties' and
  60                 'info_penalties' who are themeselves arrays of 0 or
  61                 more penalties.  Returns event on error.
  62         /
  63 );
  64
  65 # --------------------------------------------------------------
  66 # modes:
  67 #  - update
  68 #  - background : modifier to 'update' which says to return
  69 #               immediately then continue processing.  If this flag is set
  70 #               then the caller will get no penalty info and will never
  71 #               know for sure if the call even succeeded.
  72 # --------------------------------------------------------------
  73 sub patron_penalty {
  74         my( $self, $conn, $args ) = @_;
  75
  76         my( $patron, $evt );
  77
  78         $conn->respond_complete(1) if $$args{background};
  79
  80         return { fatal_penalties => [], info_penalties => [] }
  81                 unless ($args->{patron} || $args->{patronid});
  82
  83         $args->{patron_id} = $args->{patronid};
  84         $args->{fetch_patron_circ_info} = 1;
  85         my $runner = OpenILS::Application::Circ::ScriptBuilder->build($args);
  86
  87         # - Load up the script and run it
  88         $runner->add_path($_) for @$path;
  89
  90         $runner->load($script);
  91         my $result = $runner->run or throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
  92
  93         my @fatals = @{$result->{fatalEvents}};
  94         my @infos = @{$result->{infoEvents}};
  95         my $all = [ @fatals, @infos ];
  96
  97         $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
  98
  99         $conn->respond_complete(
 100                 { fatal_penalties => \@fatals, info_penalties => \@infos });
 101
 102         # - update the penalty info in the db if necessary
 103         $logger->debug("update penalty settings = " . $$args{update});
 104
 105         $evt = update_patron_penalties(
 106                 patron    => $args->{patron},
 107                 penalties => $all ) if $$args{update};
 108
 109         # - The caller won't know it failed, so log it
 110         $logger->error("penalty: Error updating the patron ".
 111                 "penalties in the database: ".Dumper($evt)) if $evt;
 112
 113         $runner->cleanup;
 114         return undef;
 115 }
 116
 117 # --------------------------------------------------------------
 118 # Removes existing penalties for the patron that are not passed
 119 # into this function.  Creates new penalty entries for the
 120 # provided penalties that don't already exist;
 121 # --------------------------------------------------------------
 122 sub update_patron_penalties {
 123
 124         my %args      = @_;
 125         my $patron    = $args{patron};
 126         my $penalties = $args{penalties};
 127         my $pid = $patron->id;
 128
 129
 130         $logger->debug("updating penalties for patron $pid => @$penalties");
 131         my $editor = new_editor(xact =>1);
 132
 133
 134         # - fetch the current penalties
 135         my $existing = $editor->search_actor_user_standing_penalty({usr=>$pid});
 136
 137         my @types;
 138         push( @types, $_->penalty_type ) for @$existing;
 139         $logger->info("penalty: user has existing penalties [@types]");
 140
 141         my @deleted;
 142
 143         # If an existing penalty is not in the newly generated
 144         # list of penalties, remove it from the DB
 145         for my $e (@$existing) {
 146                 if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
 147
 148                         $logger->activity("penalty: removing user penalty ".
 149                                 $e->penalty_type . " from user $pid");
 150
 151                         $editor->delete_actor_user_standing_penalty($e)
 152                                 or return $editor->event;
 153                 }
 154         }
 155
 156         # Add penalties that previously didn't exist
 157         for my $p (@$penalties) {
 158                 if( ! grep { $_->penalty_type eq $p } @$existing ) {
 159
 160                         $logger->activity("penalty: adding user penalty $p to user $pid");
 161
 162                         my $newp = Fieldmapper::actor::user_standing_penalty->new;
 163                         $newp->penalty_type( $p );
 164                         $newp->usr( $pid );
 165
 166                         $editor->create_actor_user_standing_penalty($newp)
 167                                 or return $editor->event;
 168                 }
 169         }
 170
 171         $editor->commit;
 172         return undef;
 173 }
 174
 175
 176
 177
 178
 179 1;