[open-ils-commits] r11284 - in trunk/Open-ILS/src/perlmods/OpenILS: . Application Utils
svn at svn.open-ils.org
svn at svn.open-ils.org
Thu Nov 20 12:38:21 EST 2008
Author: erickson
Date: 2008-11-20 12:38:19 -0500 (Thu, 20 Nov 2008)
New Revision: 11284
Added:
trunk/Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm
Modified:
trunk/Open-ILS/src/perlmods/OpenILS/Application/Actor.pm
trunk/Open-ILS/src/perlmods/OpenILS/Application/Penalty.pm
trunk/Open-ILS/src/perlmods/OpenILS/Const.pm
Log:
penalty overhaul, part 1. using new in-db penalty configs and updated penalty app to use them. added actor method to apply a specific penalty
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Actor.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Actor.pm 2008-11-20 17:26:13 UTC (rev 11283)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Actor.pm 2008-11-20 17:38:19 UTC (rev 11284)
@@ -30,6 +30,7 @@
use OpenILS::Application::Actor::ClosedDates;
use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Utils::Penalty;
use OpenILS::Application::Actor::UserGroups;
sub initialize {
@@ -310,9 +311,6 @@
($new_patron, $evt) = _create_perm_maps($session, $user_session, $patron, $new_patron, $user_obj);
return $evt if $evt;
- ($new_patron, $evt) = _create_standing_penalties($session, $user_session, $patron, $new_patron, $user_obj);
- return $evt if $evt;
-
$logger->activity("user ".$user_obj->id." updating/creating user ".$new_patron->id);
my $opatron;
@@ -897,38 +895,6 @@
return scalar(@$maps);
}
-
-sub _create_standing_penalties {
-
- my($session, $user_session, $patron, $new_patron) = @_;
-
- my $maps = $patron->standing_penalties;
- my $method;
-
- for my $map (@$maps) {
-
- if ($map->isdeleted()) {
- $method = "open-ils.storage.direct.actor.user_standing_penalty.delete";
- } elsif ($map->isnew()) {
- $method = "open-ils.storage.direct.actor.user_standing_penalty.create";
- $map->clear_id;
- } else {
- next;
- }
-
- $map->usr($new_patron->id);
-
- $logger->debug( "Updating standing penalty with method $method and session $user_session and map $map" );
-
- my $stat = $session->request($method, $map)->gather(1);
- return (undef, $U->DB_UPDATE_FAILED($map)) unless $stat;
- }
-
- return ($new_patron, undef);
-}
-
-
-
__PACKAGE__->register_method(
method => "search_username",
api_name => "open-ils.actor.user.search.username",
@@ -2762,19 +2728,46 @@
__PACKAGE__->register_method(
method => "update_penalties",
api_name => "open-ils.actor.user.penalties.update");
+
sub update_penalties {
- my( $self, $conn, $auth, $userid ) = @_;
- my $e = new_editor(authtoken=>$auth);
- return $e->event unless $e->checkauth;
- $U->update_patron_penalties(
- authtoken => $auth,
- patronid => $userid,
- );
- return 1;
+ my( $self, $conn, $auth, $user_id ) = @_;
+ my $e = new_editor(authtoken=>$auth, xact => 1);
+ return $e->die_event unless $e->checkauth;
+ my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
+ return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+ my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id);
+ return $evt if $evt;
+ $e->commit;
+ return 1;
}
+__PACKAGE__->register_method(
+ method => "apply_penalty",
+ api_name => "open-ils.actor.user.penalty.apply");
+sub apply_penalty {
+ my($self, $conn, $auth, $user_id, $penalty_name) = @_;
+ my $e = new_editor(authtoken=>$auth, xact => 1);
+ return $e->die_event unless $e->checkauth;
+ my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
+ return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+ my $penalty = $e->search_config_standing_penalty({name => $penalty_name})->[0]
+ or return $e->die_event;
+
+ # is it already applied?
+ return 1 if $e->search_actor_user_standing_penalty(
+ {usr => $user_id, standing_penalty => $penalty->id})->[0];
+
+ my $newp = Fieldmapper::actor::user_standing_penalty->new;
+ $newp->standing_penalty($penalty->id);
+ $newp->usr($user_id);
+ $e->create_actor_user_standing_penalty($newp) or return $e->die_event;
+ $e->commit;
+ return 1;
+}
+
+
__PACKAGE__->register_method(
method => "user_retrieve_fleshed_by_id",
api_name => "open-ils.actor.user.fleshed.retrieve",);
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Penalty.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Penalty.pm 2008-11-20 17:26:13 UTC (rev 11283)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Penalty.pm 2008-11-20 17:38:19 UTC (rev 11284)
@@ -1,51 +1,11 @@
package OpenILS::Application::Penalty;
use strict; use warnings;
-use DateTime;
-use Data::Dumper;
use OpenSRF::EX qw(:try);
-use OpenSRF::Utils::Cache;
-use OpenSRF::Utils qw/:datetime/;
-use OpenILS::Application::Circ::ScriptBuilder;
-use OpenSRF::Utils::SettingsClient;
-use OpenILS::Application::AppUtils;
-use OpenSRF::Utils::Logger qw(:logger);
-use OpenILS::Utils::CStoreEditor qw/:funcs/;
use OpenILS::Application;
+use OpenILS::Utils::Penalty;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
use base 'OpenILS::Application';
-my $U = "OpenILS::Application::AppUtils";
-my $script;
-my $path;
-my $libs;
-my $runner;
-my %groups; # - user groups
-
-my $fatal_key = 'result.fatalEvents';
-my $info_key = 'result.infoEvents';
-
-
-# --------------------------------------------------------------
-# Loads the config info
-# --------------------------------------------------------------
-sub initialize {
-
- my $conf = OpenSRF::Utils::SettingsClient->new;
- my @pfx = ( "apps", "open-ils.penalty","app_settings" );
- $path = $conf->config_value( @pfx, 'script_path');
- $script = $conf->config_value( @pfx, 'patron_penalty' );
-
- $path = (ref($path)) ? $path : [$path];
-
- if(!($path and $script)) {
- $logger->error("penalty: server config missing script and/or script path");
- return 0;
- }
-
- $logger->info("penalty: Loading patron penalty script $script with paths @$path");
-}
-
-
-
__PACKAGE__->register_method (
method => 'patron_penalty',
api_name => 'open-ils.penalty.patron_penalty.calculate',
@@ -64,119 +24,18 @@
);
# --------------------------------------------------------------
-# modes:
-# - update
-# - background : modifier to 'update' which says to return
-# immediately then continue processing. If this flag is set
-# then the caller will get no penalty info and will never
-# know for sure if the call even succeeded.
+# if $args->{background} is true, immediately respond complete
+# to the caller, then finish the calculation
# --------------------------------------------------------------
sub patron_penalty {
my( $self, $conn, $args ) = @_;
-
- my( $patron, $evt );
-
$conn->respond_complete(1) if $$args{background};
-
- return { fatal_penalties => [], info_penalties => [] }
- unless ($args->{patron} || $args->{patronid});
-
- $args->{patron_id} = $args->{patronid};
- $args->{fetch_patron_circ_info} = 1;
- $args->{fetch_patron_money_info} = 1;
- $args->{ignore_user_status} = 1;
-
- $args->{editor} = undef; # just to be safe
- my $runner = OpenILS::Application::Circ::ScriptBuilder->build($args);
-
- # - Load up the script and run it
- $runner->add_path($_) for @$path;
-
- $runner->load($script);
- my $result = $runner->run or throw OpenSRF::EX::ERROR ("Patron Penalty Script Died: $@");
-
- my @fatals = @{$result->{fatalEvents}};
- my @infos = @{$result->{infoEvents}};
- my $all = [ @fatals, @infos ];
-
- $logger->info("penalty: script returned fatal events [@fatals] and info events [@infos]");
-
- $conn->respond_complete(
- { fatal_penalties => \@fatals, info_penalties => \@infos });
-
- # - update the penalty info in the db if necessary
- $logger->debug("update penalty settings = " . $$args{update});
-
- $evt = update_patron_penalties(
- patron => $args->{patron},
- penalties => $all) if $$args{update};
-
- # - The caller won't know it failed, so log it
- $logger->error("penalty: Error updating the patron ".
- "penalties in the database: ".Dumper($evt)) if $evt;
-
- $runner->cleanup;
- return undef;
+ my $e = new_editor(xact => 1);
+ OpenILS::Utils::Penalty->calculate_penalties($e, $args->{patronid});
+ my $p = OpenILS::Utils::Penalty->retrieve_penalties($e, $args->{patronid});
+ $e->commit;
+ return $p
}
-# --------------------------------------------------------------
-# Removes existing penalties for the patron that are not passed
-# into this function. Creates new penalty entries for the
-# provided penalties that don't already exist;
-# --------------------------------------------------------------
-sub update_patron_penalties {
- my %args = @_;
- my $patron = $args{patron};
- my $penalties = $args{penalties};
- my $editor = new_editor(xact=>1);
- my $pid = $patron->id;
-
- $logger->debug("updating penalties for patron $pid => @$penalties");
-
- # - fetch the current penalties
- my $existing = $editor->search_actor_user_standing_penalty({usr=>$pid});
-
- my @types;
- push( @types, $_->penalty_type ) for @$existing;
- $logger->info("penalty: user has existing penalties [@types]");
-
- my @deleted;
-
- # If an existing penalty is not in the newly generated
- # list of penalties, remove it from the DB
- for my $e (@$existing) {
- if( ! grep { $_ eq $e->penalty_type } @$penalties ) {
-
- $logger->activity("penalty: removing user penalty ".
- $e->penalty_type . " from user $pid");
-
- $editor->delete_actor_user_standing_penalty($e)
- or return $editor->die_event;
- }
- }
-
- # Add penalties that previously didn't exist
- for my $p (@$penalties) {
- if( ! grep { $_->penalty_type eq $p } @$existing ) {
-
- $logger->activity("penalty: adding user penalty $p to user $pid");
-
- my $newp = Fieldmapper::actor::user_standing_penalty->new;
- $newp->penalty_type( $p );
- $newp->usr( $pid );
-
- $editor->create_actor_user_standing_penalty($newp)
- or return $editor->die_event;
- }
- }
-
- $editor->commit;
- return undef;
-}
-
-
-
-
-
1;
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Const.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Const.pm 2008-11-20 17:26:13 UTC (rev 11283)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Const.pm 2008-11-20 17:38:19 UTC (rev 11284)
@@ -101,8 +101,13 @@
econst OILS_ACQ_DEBIT_TYPE_PURCHASE => 'purchase';
econst OILS_ACQ_DEBIT_TYPE_TRANSFER => 'xfer';
+# all penalties with ID < 100 are managed automatically
+econst OILS_PENALTY_AUTO_ID => 100;
+econst OILS_PENALTY_PATRON_EXCEEDS_FINES => 1;
+econst OILS_PENALTY_PATRON_EXCEEDS_OVERDUE_COUNT => 2;
+
# ---------------------------------------------------------------------
# finally, export all the constants
# ---------------------------------------------------------------------
Added: trunk/Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm (rev 0)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm 2008-11-20 17:38:19 UTC (rev 11284)
@@ -0,0 +1,130 @@
+package OpenILS::Utils::Penalty;
+use strict; use warnings;
+use DateTime;
+use Data::Dumper;
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::Cache;
+use OpenSRF::Utils qw/:datetime/;
+use OpenILS::Application::AppUtils;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Const qw/:const/;
+my $U = "OpenILS::Application::AppUtils";
+
+my $grp_penalty_thresholds = {};
+
+
+# calculate and update the well-known penalties
+sub calculate_penalties {
+ my($class, $e, $user_id, $user) = @_;
+
+ $user = $user || $e->retrieve_actor_user($user_id);
+ $user_id = $user->id;
+ my $grp_id = (ref $user->profile) ? $user->profile->id : $user->profile;
+
+ my $penalties = $e->search_actor_user_standing_penalty({usr => $user_id});
+ my $stats = $class->collect_user_stats($e, $user_id);
+ my $overdue = $stats->{overdue};
+ my $mon_owed = $stats->{money_owed};
+ my $thresholds = $class->get_group_penalty_thresholds($e, $grp_id);
+
+ $logger->info("patron $user_id in group $grp_id has $overdue overdue circulations and owes $mon_owed");
+
+ for my $thresh (@$thresholds) {
+ my $evt;
+
+ if($thresh->penalty == OILS_PENALTY_PATRON_EXCEEDS_FINES) {
+ $evt = $class->check_apply_penalty(
+ $e, $user_id, $penalties, OILS_PENALTY_PATRON_EXCEEDS_FINES, $thresh->threshold, $mon_owed);
+ return $evt if $evt;
+ }
+
+ if($thresh->penalty == OILS_PENALTY_PATRON_EXCEEDS_OVERDUE_COUNT) {
+ $evt = $class->check_apply_penalty(
+ $e, $user_id, $penalties, OILS_PENALTY_PATRON_EXCEEDS_OVERDUE_COUNT, $thresh->threshold, $overdue);
+ return $evt if $evt;
+ }
+ }
+}
+
+# if a given penalty does not already exist in the DB, this creates it.
+# If it does exist and should not, this removes it.
+sub check_apply_penalty {
+ my($class, $e, $user_id, $all_penalties, $penalty_id, $threshold, $value) = @_;
+ my ($existing) = grep { $_->standing_penalty == $penalty_id } @$all_penalties;
+
+ # penalty threshold has been exceeded and needs to be added
+ if($value >= $threshold and not $existing) {
+ my $newp = Fieldmapper::actor::user_standing_penalty->new;
+ $newp->standing_penalty($penalty_id);
+ $newp->usr($user_id);
+ $e->create_actor_user_standing_penalty($newp) or return $e->die_event;
+
+ # patron is within penalty range and existing penalty must be removed
+ } elsif($value < $threshold and $existing) {
+ $e->delete_actor_user_standing_penalty($existing)
+ or return $e->die_event;
+ }
+
+ return undef;
+}
+
+
+sub collect_user_stats {
+ my($class, $e, $user_id) = @_;
+
+ my $stor_ses = $U->start_db_session();
+ my $money_owed = $stor_ses->request(
+ 'open-ils.storage.actor.user.total_owed', $user_id)->gather(1);
+ my $checkouts = $stor_ses->request(
+ 'open-ils.storage.actor.user.checked_out.count', $user_id)->gather(1);
+ $U->rollback_db_session($stor_ses);
+
+ return {
+ overdue => $checkouts->{overdue} || 0,
+ money_owed => $money_owed || 0
+ };
+}
+
+# get the ranged set of penalties for a give group
+sub get_group_penalty_thresholds {
+ my($class, $e, $grp_id) = @_;
+# return $grp_penalty_thresholds->{$grp_id} if $grp_penalty_thresholds->{$grp_id};
+ my @thresholds;
+ my $cur_grp = $grp_id;
+ do {
+ my $thresh = $e->search_permission_grp_penalty_threshold({grp => $cur_grp});
+ for my $t (@$thresh) {
+ push(@thresholds, $t) unless (grep { $_->name eq $t->name } @thresholds);
+ }
+ } while(defined ($cur_grp = $e->retrieve_permission_grp_tree($cur_grp)->parent));
+
+# return $grp_penalty_thresholds->{$grp_id} = \@thresholds;
+ return \@thresholds;
+}
+
+
+# any penalties whose block_list has an item from @fatal_mask will be sorted
+# into the fatal_penalties set. Others will be sorted into the info_penalties set
+sub retrieve_penalties {
+ my($class, $e, $user_id, @fatal_mask) = @_;
+ my $penalties = $e->search_actor_user_standing_penalty({usr => $user_id});
+ my(@info, @fatal);
+ for my $p (@$penalties) {
+ my $pushed = 0;
+ if($p->block_list) {
+ for my $m (@fatal_mask) {
+ if($p->block_list =~ /$m/) {
+ push(@fatal, $p->name);
+ $pushed = 1;
+ }
+ }
+ }
+ push(@info, $p->name) unless $pushed;
+ }
+
+ return {fatal_penalties => \@fatal, info_penalties => \@info};
+}
+
+1;
More information about the open-ils-commits
mailing list