penalty overhaul, part 1. using new in-db penalty configs and updated penalty app...
authorerickson <erickson@dcc99617-32d9-48b4-a31d-7c20da2025e4>
Thu, 20 Nov 2008 17:38:19 +0000 (17:38 +0000)
committererickson <erickson@dcc99617-32d9-48b4-a31d-7c20da2025e4>
Thu, 20 Nov 2008 17:38:19 +0000 (17:38 +0000)
git-svn-id: svn://svn.open-ils.org/ILS/trunk@11284 dcc99617-32d9-48b4-a31d-7c20da2025e4

Open-ILS/src/perlmods/OpenILS/Application/Actor.pm
Open-ILS/src/perlmods/OpenILS/Application/Penalty.pm
Open-ILS/src/perlmods/OpenILS/Const.pm
Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm [new file with mode: 0644]

index f73849b..6b5038e 100644 (file)
@@ -30,6 +30,7 @@ use OpenILS::Application::Actor::Container;
 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 @@ sub update_patron {
        ($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 @@ sub set_user_perms {
        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,17 +2728,44 @@ sub trim_tree {
 __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(
index 094ae47..753871c 100644 (file)
@@ -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 @@ __PACKAGE__->register_method (
 );
 
 # --------------------------------------------------------------
-# 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;
index 358b333..91ecbf5 100644 (file)
@@ -101,6 +101,11 @@ econst OILS_BILLING_NOTE_SYSTEM => 'SYSTEM GENERATED';
 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;
+
 
 
 # ---------------------------------------------------------------------
diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm b/Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm
new file mode 100644 (file)
index 0000000..bafc337
--- /dev/null
@@ -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;