[open-ils-commits] r12028 - in trunk/Open-ILS/src/perlmods/OpenILS/Application: . Trigger
svn at svn.open-ils.org
svn at svn.open-ils.org
Sat Jan 31 23:43:01 EST 2009
Author: miker
Date: 2009-01-31 23:42:59 -0500 (Sat, 31 Jan 2009)
New Revision: 12028
Added:
trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/EventGroup.pm
Modified:
trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm
trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Event.pm
Log:
adding event group support
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Event.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Event.pm 2009-01-31 23:47:43 UTC (rev 12027)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Event.pm 2009-02-01 04:42:59 UTC (rev 12028)
@@ -12,10 +12,16 @@
sub new {
my $class = shift;
my $id = shift;
+ my $editor = shift;
$class = ref($class) || $class;
- my $self = bless { id => $id, editor => new_editor() } => $class;
+ return $id if (ref($id) && ref($id) == $class);
+ my $standalone = $editor ? 0 : 1;
+ $editor ||= new_editor();
+
+ my $self = bless { id => $id, editor => $editor, standalone => $standalone } => $class;
+
return $self->init()
}
@@ -266,6 +272,15 @@
return $self->{target};
}
+sub standalone {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ my $t = shift;
+ $self->{standalone} = $t if (defined $t);
+ return $self->{standalone};
+}
+
sub update_state {
my $self = shift;
return undef unless ($self && ref $self);
@@ -273,7 +288,9 @@
my $state = shift;
return undef unless ($state);
- $self->editor->xact_begin || return undef;
+ if ($self->standalone) {
+ $self->editor->xact_begin || return undef;
+ }
my $e = $self->editor->retrieve_action_trigger_event( $self->id );
$e->start_time( 'now' ) unless $e->start_time;
@@ -285,10 +302,10 @@
my $ok = $self->editor->update_action_trigger_event( $e );
if (!$ok) {
- $self->editor->xact_rollback;
+ $self->editor->xact_rollback if ($self->standalone);
return undef;
} else {
- $ok = $self->editor->xact_commit;
+ $ok = $self->editor->xact_commit if ($self->standalone);
}
if ($ok) {
Added: trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/EventGroup.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/EventGroup.pm (rev 0)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger/EventGroup.pm 2009-02-01 04:42:59 UTC (rev 12028)
@@ -0,0 +1,242 @@
+package OpenILS::Application::Trigger::EventGroup;
+use OpenILS::Application::Trigger::Event;
+use base 'OpenILS::Application::Trigger::Event';
+use OpenSRF::EX qw/:try/;
+
+use OpenSRF::Utils::Logger qw/:level/;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::Trigger::ModRunner;
+
+my $log = 'OpenSRF::Utils::Logger';
+
+sub new {
+ my $class = shift;
+ my @ids = @_;
+ $class = ref($class) || $class;
+
+ my $editor = new_editor(xact=>1);
+
+ my $self = bless {
+ environment => {},
+ events => [
+ map {
+ ref($_) ?
+ do { $_->standalone(0); $_->editor($editor); $_ } :
+ OpenILS::Application::Trigger::Event->new($_, $editor)
+ } @ids
+ ],
+ ids => \@ids,
+ editor => $editor
+ } => $class;
+
+
+ $self->editor->xact_commit; # flush out those updates
+ $self->editor->xact_begin;
+
+ return $self;
+}
+
+sub react {
+ my $self = shift;
+
+ return $self if (defined $self->reacted);
+
+ if ($self->valid) {
+ $self->update_state( 'reacting') || die 'Unable to update event group state';
+ $self->build_environment;
+
+ try {
+ $self->reacted(
+ OpenILS::Application::Trigger::ModRunner::Reactor
+ ->new( $self->event->event_def->reactor, $self->environment )
+ ->run
+ ->final_result
+ );
+ } otherwise {
+ $log->error( shift() );
+ $self->update_state( 'error' ) || die 'Unable to update event group state';
+ };
+
+ if (defined $self->reacted) {
+ $self->update_state( 'reacted' ) || die 'Unable to update event group state';
+ } else {
+ $self->update_state( 'error' ) || die 'Unable to update event group state';
+ }
+ } else {
+ $self->{reacted} = undef;
+ }
+ return $self;
+}
+
+sub validate {
+ my $self = shift;
+
+ return $self if (defined $self->valid);
+
+ $self->update_state( 'validating') || die 'Unable to update event group state';
+ $self->editor->xact_begin;
+
+ my @valid_events;
+ try {
+ for my $event ( @{ $self->events } ) {
+ $event->validate;
+ push @valid_events, $event if ($event->valid);
+ }
+ $self->valid(1) if (@valid_events);
+ $self->{events} = \@valid_events;
+ $self->editor->xact_commit;
+ } otherwise {
+ $log->error( shift() );
+ $self->editor->xact_rollback;
+ $self->update_state( 'error' ) || die 'Unable to update event group state';
+ };
+
+ return $self;
+}
+
+sub cleanedup {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ my $c = shift;
+ $self->{cleanedup} = $c if (defined $c);
+ return $self->{cleanedup};
+}
+
+sub reacted {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ my $r = shift;
+ $self->{reacted} = $r if (defined $r);
+ return $self->{reacted};
+}
+
+sub valid {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ my $v = shift;
+ $self->{valid} = $v if (defined $v);
+ return $self->{valid};
+}
+
+sub event {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ return $self->{events}[0];
+}
+
+sub events {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ return $self->{events};
+}
+
+sub ids {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ return $self->{ids};
+}
+
+sub environment {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ my $e = shift;
+ $self->{environment} = $e if (defined $e);
+ return $self->{environment};
+}
+
+sub editor {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ my $e = shift;
+ $self->{editor} = $e if (defined $e);
+ return $self->{editor};
+}
+
+sub unfind {
+ my $self = shift;
+ return undef unless (ref $self);
+
+ die 'Cannot unfind a reacted event group' if (defined $self->reacted);
+
+ $self->update_state( 'pending' ) || die 'Unable to update event group state';
+ $self->{events} = undef;
+ return $self;
+}
+
+sub update_state {
+ my $self = shift;
+ return undef unless ($self && ref $self);
+
+ my $state = shift;
+ return undef unless ($state);
+
+ $self->editor->xact_begin || return undef;
+
+ my @oks;
+ for my $event ( @{ $self->events } ) {
+ my $e = $self->editor->retrieve_action_trigger_event( $event->id );
+ $e->start_time( 'now' ) unless $e->start_time;
+ $e->update_time( 'now' );
+ $e->update_process( $$ );
+ $e->state( $state );
+
+ $e->clear_start_time() if ($e->state eq 'pending');
+
+ my $ok = $self->editor->update_action_trigger_event( $e );
+ if ($ok) {
+ push @oks, $ok;
+ }
+ }
+
+ if (scalar(@oks) < scalar(@{ $self->ids })) {
+ $self->editor->xact_rollback;
+ return undef;
+ } else {
+ $ok = $self->editor->xact_commit;
+ }
+
+ if ($ok) {
+ for my $event ( @{ $self->events } ) {
+ my $updated = $self->editor->data;
+ $event->start_time( $updated->start_time );
+ $event->update_time( $updated->update_time );
+ $event->update_process( $updated->update_process );
+ $event->state( $updated->state );
+ }
+ }
+
+ return $ok || undef;
+}
+
+sub build_environment {
+ my $self = shift;
+ my $env = $self->environment;
+
+ $$evn{target} = [];
+ $$evn{event} = [];
+ for my $e ( @{ $self->events } ) {
+ for my $evn_part ( keys %{ $e->environment } ) {
+ if ($env_part eq 'target') {
+ push @{ $$evn{target} }, $e->environment->{target};
+ } elsif ($env_part eq 'event') {
+ push @{ $$evn{event} }, $e->environment->{event};
+ } else {
+ $$evn{$evn_part} = $e->environment->{$evn_part};
+ }
+ }
+ }
+
+ return $self;
+}
+
+1;
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm 2009-01-31 23:47:43 UTC (rev 12027)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm 2009-02-01 04:42:59 UTC (rev 12028)
@@ -15,6 +15,7 @@
use OpenILS::Utils::Fieldmapper;
use OpenILS::Utils::CStoreEditor q/:funcs/;
use OpenILS::Application::Trigger::Event;
+use OpenILS::Application::Trigger::EventGroup;
my $log = 'OpenSRF::Utils::Logger';
@@ -117,54 +118,31 @@
argc => 1
);
-sub run_events {
+sub fire_event_group {
my $self = shift;
my $client = shift;
- my $events = shift; # expects events ready for reaction
+ my $events = shift;
- my $env = {};
- if (ref($events) eq 'ARRAY') {
- $$evn{target} = [];
- $$evn{event} = [];
- for my $e ( @$events ) {
- for my $evn_part ( keys %{ $e->environment } ) {
- if ($env_part eq 'target') {
- push @{ $$evn{target} }, $e->environment->{target};
- } elsif ($env_part eq 'event') {
- push @{ $$evn{event} }, $e->environment->{event};
- } else {
- push @{ $$evn{$evn_part} }, $e->environment->{$evn_part};
- }
- }
- }
- } else {
- $env = $events->environment;
- $events = [$events];
- }
+ my $e = OpenILS::Application::Trigger::EventGroup->new(@$events);
- my @event_list;
- for my $e ( @$events ) {
- next unless ($e->valid);
- push @event_list, $e;
+ if ($e->validate->valid) {
+ $e->react->cleanup;
}
- $event_list[0]->react( $env );
- $event_list[0]->cleanup( $env );
-
return {
- reacted => $event_list[0]->reacted,
- cleanedup => $event_list[0]->cleanedup,
- events => @event_list == 1 ? $event_list[0] : \@event_list
+ valid => $e->valid,
+ reacted => $e->reacted,
+ cleanedup => $e->cleanedup,
+ events => $e->events
};
}
__PACKAGE__->register_method(
- api_name => 'open-ils.trigger.event.run_validated',
- method => 'fire_single_event',
+ api_name => 'open-ils.trigger.event_group.fire',
+ method => 'fire_event_group',
api_level=> 1,
argc => 1
);
-
sub pending_events {
my $self = shift;
my $client = shift;
@@ -209,10 +187,10 @@
# push this event onto the event+grouping_pkey_value stack
$groups{$e->event->event_def->id}{$ident_value} ||= [];
- push @{ $groups{$e->event->event_def->id}{$ident_value} }, $e_id;
+ push @{ $groups{$e->event->event_def->id}{$ident_value} }, $e;
} else {
# it's a non-grouped event
- push @{ $groups{'*'} }, $e_id;
+ push @{ $groups{'*'} }, $e;
}
}
}
@@ -220,10 +198,45 @@
return \%groups;
}
__PACKAGE__->register_method(
- api_name => 'open-ils.trigger.event.found_by_group',
+ api_name => 'open-ils.trigger.event.find_pending_by_group',
method => 'grouped_events',
api_level=> 1
);
+sub run_all_events {
+ my $self = shift;
+ my $client = shift;
+ my ($groups) = $self->method_lookup('open-ils.trigger.event.find_pending_by_group')->run();
+
+ for my $def ( %$groups ) {
+ if ($def eq '*') {
+ for my $event ( @{ $$groups{'*'} } ) {
+ $client->respond(
+ $self
+ ->method_lookup('open-ils.trigger.event.fire')
+ ->run($event)
+ );
+ }
+ } else {
+ my $defgroup = $$groups{$def};
+ for my $ident ( keys %$defgroup ) {
+ $client->respond(
+ $self
+ ->method_lookup('open-ils.trigger.event_group.fire')
+ ->run($$defgroup{$ident})
+ );
+ }
+ }
+ }
+
+
+}
+__PACKAGE__->register_method(
+ api_name => 'open-ils.trigger.event.run_all_pending',
+ method => 'run_all_events',
+ api_level=> 1
+);
+
+
1;
More information about the open-ils-commits
mailing list