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