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