BPM-Engine
view release on metacpan or search on metacpan
bin/bpmengine-spawn view on Meta::CPAN
$BPM::Engine::Store::VERSION,
"$FindBin::Bin/../var"
);
print "DDL files created in ./var \n";
}
elsif ($deploy) {
$schema->deploy({ add_drop_table => $drop_tables });
# copy as test db
unlink './t/var/bpmengine.test.db' if -f './t/var/bpmengine.test.db';
die("Test db locked") if -f './t/var/bpmengine.test.db';
File::Copy::copy('./t/var/bpmengine.db', './t/var/bpmengine.test.db');
print "Schema deployed as ./t/var/bpmengine.db\n";
}
else {
pod2usage(1);
}
#$schema->storage->backup('./var') if $connect_info[0] =~ /SQLite/;
$schema->storage->disconnect if $connect_info[0] =~ /mysql/;
lib/BPM/Engine/ProcessRunner.pm view on Meta::CPAN
unless (@transitions) {
my $act_id =
$activity->activity_name
|| $activity->activity_uid
|| $activity->id;
throw_model error =>
"Model error: no outgoing transitions for activity '$act_id'";
}
my (@instances) = ();
my (@blocked) = ();
my ($stop_following, $fired_count) = (0, 0);
my ($otherwise, $exception) = ();
# evaluate efferent transitions
foreach my $transition (@transitions) {
if ( $transition->condition_type eq 'NONE'
|| $transition->condition_type eq 'CONDITION') {
my $t_instance;
unless ($stop_following) {
$t_instance =
lib/BPM/Engine/ProcessRunner.pm view on Meta::CPAN
}
if ($t_instance) {
push(@instances, [$transition, $t_instance]);
$fired_count++;
# only one transition in an XOR split can fire.
$stop_following++ if $activity->is_xor_split;
}
elsif ($activity->is_split) {
my $split = $instance->split
or die("No split for " . $activity->activity_uid);
$split->set_transition($transition->id, 'blocked');
push(@blocked, [$transition, $instance]);
}
}
elsif ($transition->condition_type eq 'OTHERWISE') {
$otherwise = $transition;
}
elsif ($transition->condition_type eq 'DEFAULTEXCEPTION'
|| $transition->condition_type eq 'EXCEPTION') {
$exception = $transition;
}
lib/BPM/Engine/ProcessRunner.pm view on Meta::CPAN
push(@instances, [$otherwise, $t_instance]);
}
else {
throw_runner error =>
"Execution of transition with 'Otherwise' condition failed";
}
}
elsif ($otherwise && $activity->is_split) {
my $split = $instance->split
or die("No join found for split " . $activity->activity_uid);
$split->set_transition($otherwise->id, 'blocked');
}
# activate successor activities
my $followed_back = 0;
foreach my $inst (@instances) {
$followed_back++ if $inst->[0]->is_back_edge;
my $r_instance = $inst->[1];
my $r_activity = $r_instance->activity;
$self->_enqueue_ai($r_activity, $r_instance);
}
# blocked paths may trigger downstream deferred activities which must now be
# resolved; signal deferred activity instances on other branches in the
# wf-net when paths were blocked and any transition downstream was followed
if (scalar(@blocked) && $followed_back != scalar @instances) {
$self->_signal_upstream_orjoins_if_in_split_branch(@blocked);
}
return;
}
sub _execute_transition {
my ($self, $transition, $from_instance, $run) = @_;
#XXX mitigate expensive debugging
my $tid = $transition->transition_uid || $transition->id || 'noid';
lib/BPM/Engine/ProcessRunner.pm view on Meta::CPAN
$self->debug("runner: _enqueue Pushing instance "
. $activity->activity_uid
. " to deferred queue");
$self->_defer_push([$activity, $instance]) unless $deferred;
}
}
sub _signal_upstream_orjoins_if_in_split_branch {
my ($self, @blocked) = @_;
my @deferred = $self->process_instance->activity_instances->deferred->all;
foreach my $instance (@deferred) {
$self->debug("runner: _run Pushing db instance "
. $instance->activity->activity_uid
. " to deferred queue");
my $graph = $self->graph;
foreach my $block (@blocked) {
my $tr = $block->[0];
my $ai = $block->[1];
my $a_to = $tr->to_activity;
if ($graph->is_reachable($a_to->id, $instance->activity->id)) {
$self->_defer_push([$instance->activity, $instance]);
}
}
}
}
lib/BPM/Engine/Store/Result/ActivityInstanceSplit.pm view on Meta::CPAN
__PACKAGE__->set_primary_key(qw/ split_id /);
__PACKAGE__->belongs_to(
activity_instance => 'BPM::Engine::Store::Result::ActivityInstance', 'token_id'
);
sub set_transition {
my ($self, $transition_id, $state) = @_;
die("Invalid split state '$state'") unless $state =~ /^(taken|blocked|joined)$/;
my $states = $self->states || {};
if($states->{$transition_id} && $state ne 'joined') {
die("Transition state '$state' already set in Join as '" .
$states->{$transition_id} . "'"
);
}
elsif(!$states->{$transition_id} && $state eq 'joined') {
die("State '$state' not previously taken for transition '$transition_id'");
}
lib/BPM/Engine/Store/ResultRole/ActivityInstanceJoin.pm view on Meta::CPAN
->resultset('ActivityInstance')->deferred({
activity_id => $self->activity->id,
process_instance_id => $self->process_instance_id,
tokenset => $self->tokenset,
});
my %deferred_trans = map { $_->transition_id => 1 } $deferred_states->all;
$deferred_trans{$self->transition_id} = 1;
# Each transition corresponds to either waiting for upstream,
# executed+deferred, blocked, the start of a new cycle or this ai's
# transition itself. Join should fire if there's no upstream activity left.
foreach my $transition($self->activity->transitions_in->all) {
next if($deferred_trans{$transition->id});
next if($transition->is_back_edge);
return 0 unless $self->_upstream_blocked($transition);
}
return 1;
}
# Search the transition's upstream subnet for active or blocked activity
# instances. Transition has not been applied yet, so either
# - still activity further upstream (last ai in process thread=active), or
# - split.path blocked for last completed ai in process thread
sub _upstream_blocked {
my ($self, $transition) = @_;
my $rs = $self->process_instance->activity_instances_rs({
tokenset => $self->tokenset,
})->active_or_completed;
my $split_blocked = sub {
my ($ai, $trans) = @_;
my $split = $ai->split || die("Inclusive split has no join attached");
$split->discard_changes;
if( $split->states->{$trans->id}
&& $split->states->{$trans->id} eq 'blocked') {
# no blocking if followed a backedge upstream (cyclic wf)
my @tids =
map { $_->id }
$ai->activity->transitions({ is_back_edge => 1 })->all;
if(scalar @tids) {
return 0 if $ai->next({ transition_id => [@tids] })->count;
}
return 1;
}
else {
lib/BPM/Engine/Store/ResultRole/ActivityInstanceJoin.pm view on Meta::CPAN
# no activity instances, traverse further upstream
if(!scalar @ai) {
foreach my $trans($upstream_act->transitions_in) {
next if $trans->is_back_edge;
my $src = $trans->from_activity;
unless($src->id == $self->activity->id) {
push(@act, [$src, $trans]);
}
}
}
# active or completed+blocked instances
else {
$seen++;
my %status = ();
foreach(@ai) {
$status{
$_->is_deferred ? 'deferred' :
($_->is_completed ? 'completed' : 'active')
}++;
}
die("Invalid db state for instances " . $upstream_act->activity_uid)
if($status{deferred} && ($status{active} || $status{completed}));
die("Invalid db state for instances " . $upstream_act->activity_uid)
if($status{active} && $status{active} > 1);
# active ai, may have come from split upstream
if($status{active}) {
return 0;
}
# completed, is_split, blocked transition path
elsif($status{completed} && scalar(keys %status) == 1) {
# OR-split should be blocked, XOR split missed this transition by definition
if($upstream_act->is_or_split) {
my $blocked = 0;
foreach my $ai(@ai) {
$blocked++ if &$split_blocked($ai, $down_trans);
}
die("OR split " . $upstream_act->activity_uid . " completed but not blocked")
unless $blocked;
}
elsif(!$upstream_act->is_xor_split) {
die("Not an OR/XOR split " . $upstream_act->activity_uid);
}
$block++;
}
else {
die("Wrong status");
}
}
t/04-run/01-transition.t view on Meta::CPAN
is($ai_B1->activity->activity_uid, 'ex4.B1','derive_and_accept results in B1');
# transition in joinA set to 'taken' since we're coming from a split
is($ai_A->split->states->{$t_A_B1->id}, 'taken', "Transition A-B1 state is 'taken'");
# after a split, the parent_token of the new ai is set to the split-ai
#is($ai_B1->parent_token_id, $ai_A->id, 'Parent matches');
#is($ai_B1->parent->id, $ai_A->id, 'Parent matches');
is($ai_B1->prev->id, $ai_A->id, 'Prev matches');
# join B1 should not fire, since although we didn't follow the path from A to B, A-B was not blocked either
# TODO: verify this is not a problem in runner!!
ok(!$ai_B1->is_enabled(), 'Join B1 should not fire');
# set A-B blocked, and see B1 enabled
$ai_A->split->discard_changes();
my $states = $ai_A->split->states;
$states->{$t_A_B->id} = 'blocked';
$ai_A->split->update({ states => $states })->discard_changes;
$ai_A->update({ completed => DateTime->now() });
ok($ai_B1->is_enabled(), 'Join B1 should fire');
is($ai_A->split->states->{$t_A_B->id}, 'blocked', "Transition A-B state is 'blocked'");
is($ai_A->split->states->{$t_A_B1->id}, 'taken', "Transition A-B1 state is 'taken'");
is($ai_B1->prev->split->states->{$t_A_B1->id}, 'taken', "Transition A-B1 state is 'taken'");
$ai_A->update({ completed => \'NULL' })->discard_changes;
delete $states->{$t_A_B->id};
$ai_A->split->update({ states => $states })->discard_changes;
ok(!$ai_B1->is_enabled(), 'Join B1 should not fire');
$ai_B1->update({ deferred => DateTime->now() });
t/04-run/01-transition.t view on Meta::CPAN
is($ai_B2->activity->activity_uid, 'ex4.B2','derive_and_accept results in B2');
# B2-D
$ai_B2->update({ completed => DateTime->now() });
ok($ai_B2->is_completed);
ok(my $ai_D = $tB2D->derive_and_accept_instance($ai_B2, { activity => $aD }, @args));
# Block B2-C
#ok(!$ai_C->is_enabled(), 'Join C should not fire'); # needs block when B2 completed
my $split = $ai_B2->split or die("No join found for split");
$split->set_transition($tB2C->id, 'blocked');
ok($ai_C->is_enabled(), 'Join C should fire');
$ai_C->update({ deferred => undef })->discard_changes;
$ai_C->fire_join;
ok(!$ai_D->is_enabled(), 'Join D should not fire');
$ai_D->update({ deferred => DateTime->now });
# C-D
$ai_C->update({ completed => DateTime->now() });
t/04-run/01-transition.t view on Meta::CPAN
# A-B
$ai_A->update({ completed => DateTime->now() }); # normally done in processrunner complete_activity
my $ai_B = $tAB->derive_and_accept_instance($ai_A, { activity => $aB }, @args);
# B-B1
$ai_B->update({ completed => DateTime->now() });
my $ai_B1b = $tBB1->derive_and_accept_instance($ai_B, { activity => $aB1 }, @args);
ok(!$ai_B1b->is_enabled(), 'Join B1 should not fire');
my $split = $ai_A->split or die("No join found for split");
$split->set_transition($tAB1->id, 'blocked');
ok($ai_B1b->is_enabled(), 'Join B1 should fire');
}
}
# patterns: 06-iteration.xpdl
#-----------------------------------------------
# WCP10: Arbitrary Cycles (nested-loops) - test tokensets
t/04-run/02-runner.t view on Meta::CPAN
complete_active(); # complete D
#test_state(completed => [qw/B C C D DC DC MC SM XOR XOR/], active => ['SM'], deferred => []);
test_state(completed => [qw/B C C D DC DC MC XOR XOR/], active => ['SM'], deferred => ['SM']);
complete_active(); # complete SM
test_state(completed => [qw/B C C D DC DC MC SM SM XOR XOR/], active => ['End'], deferred => []);
}
else {
$pi->attribute(deferred_choice => 'E');
complete_active(); # complete DC, follow DC-E
# path D was blocked, deferred SM now enabled (path D blocked in MC-localJoin), so should fire and execute
test_state(completed => [qw/B C C DC DC MC XOR XOR/], active => ['E','SM'], deferred => []);
complete_active(); # complete E+SM
test_state(completed => [qw/B C C DC DC E End MC SM XOR XOR/], active => ['End'], deferred => []);
complete_active(); # complete End
test_state(completed => [qw/B C C DC DC E End End MC SM XOR XOR/], active => [], deferred => []);
}
}
( run in 0.667 second using v1.01-cache-2.11-cpan-49f99fa48dc )