diff --git a/LICENSE b/LICENSE index f332d3a..e0b62a5 100644 --- a/LICENSE +++ b/LICENSE @@ -290,21 +290,21 @@ Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through - textual modification. + textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright - Holder. + Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for - the package. + the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the - computing community at large as a market that must bear the fee.) + computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they - received it. + received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you diff --git a/bin/bpmengine-spawn b/bin/bpmengine-spawn index 7fa8f32..a6eefaa 100644 --- a/bin/bpmengine-spawn +++ b/bin/bpmengine-spawn @@ -46,7 +46,7 @@ elsif ($deploy) { else { pod2usage(1); } - + #$schema->storage->backup('./var') if $connect_info[0] =~ /SQLite/; $schema->storage->disconnect if $connect_info[0] =~ /mysql/; diff --git a/lib/BPM/Engine.pm b/lib/BPM/Engine.pm index 23c80de..b4033de 100644 --- a/lib/BPM/Engine.pm +++ b/lib/BPM/Engine.pm @@ -73,8 +73,8 @@ BPM::Engine - Business Process Execution Engine =head1 SYNOPSIS -Create a new bpm engine - +Create a new bpm engine + use BPM::Engine; my $callback = sub { @@ -88,15 +88,15 @@ Create a new bpm engine callback => $callback ); -Save an XPDL file with workflow process definitions, and retrieve the process +Save an XPDL file with workflow process definitions, and retrieve the process definitions - + my $package = $engine->create_package('/path/to/model.xpdl'); my @processes = $engine->get_process_definitions->all; -Create and run a process instance - +Create and run a process instance + my $instance = $engine->create_process_instance( $process, { instance_name => 'My first process run' } ); @@ -136,7 +136,7 @@ Possible options are: =item C<< schema => $schema // BpmEngineStore >> -L connected schema object. If not provided, one will be +L connected schema object. If not provided, one will be created using the C option. Either C or C is required on object construction. @@ -165,7 +165,7 @@ C, if a logger was not provided. =item C<< callback => \&cb >> -Optional callback I<&cb> which is called on all process instance events. This +Optional callback I<&cb> which is called on all process instance events. This option is passed to any C constructor. =item C<< runner_traits => [qw/TraitA TraitB/] // [] >> @@ -182,7 +182,7 @@ Optional traits to be supplied to all C objects used Provided by the base role L. Acts just like regular C, but also accepts an argument C to specify -the configfile from which to load other attributes. +the configfile from which to load other attributes. =over @@ -195,12 +195,12 @@ about supported formats. =back -Explicit arguments to C will override anything loaded from the +Explicit arguments to C will override anything loaded from the configfile. =head3 B<< BPM::Engine->new_with_traits(%options) >> -Just like C, but also accepts a C argument with a list of trait +Just like C, but also accepts a C argument with a list of trait names to apply to the engine object. $engine = BPM::Engine->new_with_traits( @@ -214,13 +214,13 @@ Options, in addition to those to C: =item C<< traits => \@traitnames // [] >> -Traits live under the C namespace by default, prefix full +Traits live under the C namespace by default, prefix full class names with a C<+>. =back =head3 B<< BPM::Engine->with_traits(@traits)->new(%options) >> - + You can use the C class method to use traits in combination with a configuration file. Example: @@ -242,8 +242,8 @@ with a configuration file. Example: =back -Get a L of -L rows. Takes the same arguments as the +Get a L of +L rows. Takes the same arguments as the L C method. =head3 get_package @@ -258,9 +258,9 @@ L C method. =back -Takes a package UUID or a hashref and optional standard -L and returns the -L row. Delegates to +Takes a package UUID or a hashref and optional standard +L and returns the +L row. Delegates to L's C method. Throws an exception if the package is not found. @@ -277,7 +277,7 @@ Throws an exception if the package is not found. =back -Takes XPDL xml input and returns a newly created Package row. Input can be a +Takes XPDL xml input and returns a newly created Package row. Input can be a file path, URL, reference to a string or io stream. Throws an exception if inconsistencies were found in the xml. @@ -294,7 +294,7 @@ Throws an exception if inconsistencies were found in the xml. =back -Delete a package from the data store. Warning: this will also delete all +Delete a package from the data store. Warning: this will also delete all processes and process instances related to the package. An exception is thrown if the package is not in the database. @@ -312,7 +312,7 @@ An exception is thrown if the package is not in the database. =back Get a L of -L rows. +L rows. Takes the same arguments as the L C method. =head3 get_process_definition @@ -329,7 +329,7 @@ Takes the same arguments as the L C method. Takes a package UUID or a hashref and optional standard L and returns the -corresponding L row. Delegates to +corresponding L row. Delegates to L's C method. Throws an exception if the process is not found. @@ -349,8 +349,8 @@ Throws an exception if the process is not found. =back Get a L of -L -rows. Takes the same arguments as the L C +L +rows. Takes the same arguments as the L C method. =head3 get_process_instance @@ -382,11 +382,11 @@ L's C method. =back -Creates a new process instance, given a process id or -L row object and an optional hash of +Creates a new process instance, given a process id or +L row object and an optional hash of process instance properties. -Of these process instance properties, C is useful to specify a +Of these process instance properties, C is useful to specify a name for the instance. A name will be auto-generated if not specified. Returns the L that was created. @@ -403,7 +403,7 @@ Returns the L that was created. =back -Starts to run a process instance given a process instance object or id, and an +Starts to run a process instance given a process instance object or id, and an optional hash of process instance attributes. =head3 delete_process_instance @@ -452,7 +452,7 @@ $state_transition =back -Sets the new state of the process instance given a process instance id or a +Sets the new state of the process instance given a process instance id or a process instance object and a state transition name. The following state transitions are possible: @@ -461,23 +461,23 @@ The following state transitions are possible: =item start -Changes the process instance state from C to +Changes the process instance state from C to C. =item suspend -Changes the process instance state from C to +Changes the process instance state from C to C. =item resume -Changes the process instance state from C to +Changes the process instance state from C to C. =item terminate -Changes the process instance state from C, -C or C to +Changes the process instance state from C, +C or C to C. This is an end state (no more state transitions possible). @@ -485,17 +485,17 @@ possible). Changes the process instance state from C, C or C to -C. This is an end state (no more state transitions +C. This is an end state (no more state transitions possible). =item finish -Changes the process instance state from C to C. +Changes the process instance state from C to C. This is an end state (no more state transitions possible). =back -An exception will be thrown for invalid state transitions, for example when the +An exception will be thrown for invalid state transitions, for example when the process instance is not in the right state to allow the transition. =head2 ACTIVITY INSTANCE METHODS @@ -518,7 +518,7 @@ rows. Takes the same arguments as the L C method. =head3 get_activity_instance - + $ai = $engine->get_activity_instance($aid); =over 4 @@ -561,17 +561,17 @@ C. =item assign -Changes the activity instance state from C or +Changes the activity instance state from C or C to C. =item reassign -Valid state transition when the activity instance state is +Valid state transition when the activity instance state is C. Does not actually change the state. =item unassign -Changes the activity instance state from C to +Changes the activity instance state from C to C. =item suspend @@ -587,13 +587,13 @@ C. =item abort Changes the activity instance state from C or -C to C. This is an end state +C to C. This is an end state (no more state transitions possible). =item finish -Changes the activity instance state from C or -C to C. This is an end state (no more +Changes the activity instance state from C or +C to C. This is an end state (no more state transitions possible). =back @@ -612,7 +612,7 @@ $attribute_name, $attribute_value? =back -Gets or sets an activity instance attribute, and returns the corresponding +Gets or sets an activity instance attribute, and returns the corresponding L row. @@ -717,7 +717,7 @@ L Copyright (c) 2010, 2011 Peter de Vos. -This module is free software; you can redistribute it and/or modify it under the +This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY diff --git a/lib/BPM/Engine/Exceptions.pm b/lib/BPM/Engine/Exceptions.pm index 963e6c9..39aeba7 100644 --- a/lib/BPM/Engine/Exceptions.pm +++ b/lib/BPM/Engine/Exceptions.pm @@ -105,22 +105,22 @@ Throw an exception when something is wrong throw_plugin("Whoops!") unless $length =~ /\d+/; # ... - } + } + +Now let's try something illegal and catch the exception -Now let's try something illegal and catch the exception - # use the is_Exception() function exported from the types library - use BPM::Engine::Types qw/Exception/; - + use BPM::Engine::Types qw/Exception/; + eval { $obj->set_length( 'non-numerical value' ); # this throws the error #... }; - + # handle any exception, cathing them in various ways if(my $err = $@) { # encountered an error - + if( Exception::Class->caught('BPM::Engine::Exception::Engine') ) { #... use the thrown error obj warn $err->error; @@ -154,14 +154,14 @@ modules and provides shortcuts to make raising an exception easier and more readable. The exceptions are subclasses of Exception::Class::Base, created by the -interface defined by C. See +interface defined by C. See L for more information on how this is done. =head1 EXCEPTIONS -Each of the exception classes created by BPM::Engine::Exceptions has a -functional alias for its throw class method. In the L -example, we use the C function to throw a +Each of the exception classes created by BPM::Engine::Exceptions has a +functional alias for its throw class method. In the L +example, we use the C function to throw a C exception. These may be imported by passing a list of the function names to import: diff --git a/lib/BPM/Engine/Handler/ActivityInstanceHandler.pm b/lib/BPM/Engine/Handler/ActivityInstanceHandler.pm index 20e658b..523ae93 100644 --- a/lib/BPM/Engine/Handler/ActivityInstanceHandler.pm +++ b/lib/BPM/Engine/Handler/ActivityInstanceHandler.pm @@ -25,7 +25,7 @@ role BPM::Engine::Handler::ActivityInstanceHandler { || throw_store(error => "ActivityInstance '$id' not found"); } - method change_activity_instance_state + method change_activity_instance_state (Int|HashRef|ActivityInstance $ai, Str $state) { $ai = $self->get_activity_instance( diff --git a/lib/BPM/Engine/Handler/ProcessDefinitionHandler.pm b/lib/BPM/Engine/Handler/ProcessDefinitionHandler.pm index f589bf4..6bff2a0 100644 --- a/lib/BPM/Engine/Handler/ProcessDefinitionHandler.pm +++ b/lib/BPM/Engine/Handler/ProcessDefinitionHandler.pm @@ -27,8 +27,8 @@ role BPM::Engine::Handler::ProcessDefinitionHandler { $self->logger->error($error); throw_store(error => $error); }; - } - + } + method create_package (Str|ScalarRef|LibXMLDoc $args) { my $package = eval { diff --git a/lib/BPM/Engine/Handler/ProcessInstanceHandler.pm b/lib/BPM/Engine/Handler/ProcessInstanceHandler.pm index 9da9f8f..1da9836 100644 --- a/lib/BPM/Engine/Handler/ProcessInstanceHandler.pm +++ b/lib/BPM/Engine/Handler/ProcessInstanceHandler.pm @@ -9,7 +9,7 @@ use MooseX::Declare; role BPM::Engine::Handler::ProcessInstanceHandler { use Scalar::Util qw/blessed/; - use BPM::Engine::Types qw/UUID/; + use BPM::Engine::Types qw/UUID/; use BPM::Engine::Exceptions qw/throw_store throw_abstract/; use aliased 'BPM::Engine::Store::Result::Process'; use aliased 'BPM::Engine::Store::Result::ProcessInstance'; @@ -46,7 +46,7 @@ role BPM::Engine::Handler::ProcessInstanceHandler { my $runner = $self->runner($pi); $runner->start_process(); - + return; } @@ -56,7 +56,7 @@ role BPM::Engine::Handler::ProcessInstanceHandler { return $pi->delete; } - method process_instance_attribute + method process_instance_attribute (Int|HashRef|ProcessInstance $pi, Str $attr, Str $value?) { $pi = $self->get_process_instance($pi) unless(blessed $pi); diff --git a/lib/BPM/Engine/ProcessRunner.pm b/lib/BPM/Engine/ProcessRunner.pm index 8a7ac8c..1edfeb6 100644 --- a/lib/BPM/Engine/ProcessRunner.pm +++ b/lib/BPM/Engine/ProcessRunner.pm @@ -75,7 +75,7 @@ has 'evaluator' => ( is => 'rw', lazy_build => 1, ); - + sub _build_evaluator { my $self = shift; return BPM::Engine::Util::ExpressionEvaluator->load( @@ -262,13 +262,13 @@ sub _execute_activity_instance { return unless $self->cb_execute_activity($activity, $instance); my $completed = 0; - + # Route if ($activity->is_route_type) { #$self->debug("runner: route type " . $activity->activity_uid); $completed = 1; } - + # Implementations are No, Task, SubFlow or Reference elsif ($activity->is_implementation_type) { $self->debug("runner: executing implementation activity '" @@ -276,13 +276,13 @@ sub _execute_activity_instance { . "'"); $completed = $self->_execute_implementation($activity, $instance); } - + # BlockActivity executes an ActivitySet elsif ($activity->is_block_type) { $self->error("runner: BlockActivity not implemented yet ..."); throw_abstract error => 'BlockActivity not implemented yet'; } - + # Events just complete, for now elsif ($activity->is_event_type) { #$self->notice("runner: Events not implemented yet ..."); @@ -348,9 +348,9 @@ sub complete_activity { my ($self, $activity, $instance, $run) = @_; $self->cb_complete_activity($activity, $instance); - + $instance->apply_transition('finish'); - $instance->fire_join if $activity->is_join; + $instance->fire_join if $activity->is_join; $instance->update({ completed => DateTime->now() }); if ($activity->is_end_activity()) { @@ -611,7 +611,7 @@ BPM::Engine::ProcessRunner - Runs Processes $runner->start_process(); # somewhere else, after completing a task, from an asynchronous task handler... - + $runner->complete_activity($activity, $instance, 1); =head1 DESCRIPTION diff --git a/lib/BPM/Engine/Role/HandlesTaskdata.pm b/lib/BPM/Engine/Role/HandlesTaskdata.pm index dcbcf0e..aa1cce6 100644 --- a/lib/BPM/Engine/Role/HandlesTaskdata.pm +++ b/lib/BPM/Engine/Role/HandlesTaskdata.pm @@ -35,11 +35,11 @@ before 'execute_task' => sub { process_instance_id => $pi->id, activity_id => $activity->id, token_id => $activity_instance->id, - task_id => $task->id, + task_id => $task->id, }, parameters => $task->actual_params, # XXX expression ApplicationFormalParams message => _message($self, $tdata->{$mtype}, $process, $pi), - service => _service($tdata->{'WebServiceOperation'}), + service => _service($tdata->{'WebServiceOperation'}), performers => _performers($activity->participants_rs), users => _performers($task->participants_rs), # $process->participants_rs( @@ -49,14 +49,14 @@ before 'execute_task' => sub { }; $activity_instance->update({ taskdata => $args }); - + return; }; sub _performers { my $p_rs = shift; return [ map { _performer($_) } $p_rs->all ]; - + #my @p = (); #while (my $rec = $p_rs->next) { # push(@p, _performer($rec)); @@ -113,28 +113,28 @@ sub _message_params { my @results = (); foreach my $attr (@$params) { - + my $output; if ($attr->{ScriptType} && $attr->{ScriptType} =~ /xslate/i) { try { $output = $self->evaluator->render($attr->{content}); } catch { - $output = "SCRIPT ERROR $_ "; - #warn Dumper $attr->{content}; + $output = "SCRIPT ERROR $_ "; + #warn Dumper $attr->{content}; #$output = $attr->{content}; }; } elsif ($attr->{content} =~ /\./) { #die("Dotted content needs ScriptType"); - try { + try { $output = $self->evaluator->dotop($attr->{content}); } catch { - $output = "SCRIPT.DOTTED ERROR $_"; + $output = "SCRIPT.DOTTED ERROR $_"; }; } - else { + else { $output = $pi->attribute($attr->{content})->value; } diff --git a/lib/BPM/Engine/Role/WithCallback.pm b/lib/BPM/Engine/Role/WithCallback.pm index a4e503c..4385e52 100644 --- a/lib/BPM/Engine/Role/WithCallback.pm +++ b/lib/BPM/Engine/Role/WithCallback.pm @@ -34,7 +34,7 @@ version 0.001 =head1 DESCRIPTION -This role provides a callback code reference to L and +This role provides a callback code reference to L and L. =head1 ATTRIBUTES diff --git a/lib/BPM/Engine/Role/WithLogger.pm b/lib/BPM/Engine/Role/WithLogger.pm index c68d2b5..f2b2d3e 100644 --- a/lib/BPM/Engine/Role/WithLogger.pm +++ b/lib/BPM/Engine/Role/WithLogger.pm @@ -53,7 +53,7 @@ version 0.001 =head1 DESCRIPTION -This role provides a logger object to L and +This role provides a logger object to L and L. =head1 ATTRIBUTES diff --git a/lib/BPM/Engine/Store/Result.pm b/lib/BPM/Engine/Store/Result.pm index dc99b3f..f24c097 100644 --- a/lib/BPM/Engine/Store/Result.pm +++ b/lib/BPM/Engine/Store/Result.pm @@ -15,7 +15,7 @@ __PACKAGE__->load_components(qw/InflateColumn::DateTime/); # override call from within DBIx::Class::InflateColumn::DateTime sub _inflate_to_datetime { my ($self, @args) = @_; - + my $val = $self->next::method(@args); return bless $val, 'BPM::Engine::DateTime'; } @@ -40,7 +40,7 @@ use warnings; use parent 'DateTime'; sub TO_JSON { - my $dt = shift; + my $dt = shift; return "$dt"; } } diff --git a/lib/BPM/Engine/Store/Result/Activity.pm b/lib/BPM/Engine/Store/Result/Activity.pm index 41ef91b..1639d78 100644 --- a/lib/BPM/Engine/Store/Result/Activity.pm +++ b/lib/BPM/Engine/Store/Result/Activity.pm @@ -24,12 +24,12 @@ __PACKAGE__->add_columns( size => 36, is_nullable => 0, is_foreign_key => 1, - }, + }, activity_uid => { data_type => 'VARCHAR', size => 64, is_nullable => 1, - }, + }, activity_name => { data_type => 'VARCHAR', size => 255, @@ -39,20 +39,20 @@ __PACKAGE__->add_columns( data_type => 'ENUM', is_nullable => 0, default => 'Implementation', - default_value => 'Implementation', - extra => { - list => [qw/Implementation Route BlockActivity Event/] + default_value => 'Implementation', + extra => { + list => [qw/Implementation Route BlockActivity Event/] }, - }, + }, implementation_type => { data_type => 'ENUM', is_nullable => 0, default => 'No', - default_value => 'No', - extra => { - list => [qw/No Tool Task SubFlow Reference/] + default_value => 'No', + extra => { + list => [qw/No Tool Task SubFlow Reference/] }, - }, + }, event_type => { data_type => 'ENUM', is_nullable => 0, @@ -71,18 +71,18 @@ __PACKAGE__->add_columns( data_type => 'ENUM', is_nullable => 0, default => 'Automatic', - default_value => 'Automatic', - extra => { - list => [qw/Automatic Manual/] + default_value => 'Automatic', + extra => { + list => [qw/Automatic Manual/] }, }, finish_mode => { data_type => 'ENUM', is_nullable => 0, default => 'Automatic', - default_value => 'Automatic', - extra => { - list => [qw/Automatic Manual/] + default_value => 'Automatic', + extra => { + list => [qw/Automatic Manual/] }, }, priority => { @@ -90,19 +90,19 @@ __PACKAGE__->add_columns( default_value => 0, is_nullable => 0, size => 21 - }, + }, start_quantity => { data_type => 'INT', default_value => 1, size => 3, is_nullable => 1, - }, + }, completion_quantity => { data_type => 'INT', default_value => 1, size => 3, is_nullable => 1, - }, + }, documentation_url => { data_type => 'VARCHAR', size => 255, @@ -112,14 +112,14 @@ __PACKAGE__->add_columns( data_type => 'VARCHAR', size => 255, is_nullable => 1, - }, + }, join_type => { data_type => 'ENUM', is_nullable => 1, default => 'NONE', default_value => 'NONE', - extra => { - list => [qw/NONE AND XOR OR Exclusive Inclusive Parallel Complex/] + extra => { + list => [qw/NONE AND XOR OR Exclusive Inclusive Parallel Complex/] }, }, join_type_exclusive => { @@ -127,28 +127,28 @@ __PACKAGE__->add_columns( is_nullable => 1, default => 'Data', default_value => 'Data', - extra => { - list => [qw/Data Event/] + extra => { + list => [qw/Data Event/] }, }, split_type => { data_type => 'ENUM', is_nullable => 0, default => 'NONE', - default_value => 'NONE', - extra => { - list => [qw/NONE AND XOR OR Exclusive Inclusive Parallel Complex/] + default_value => 'NONE', + extra => { + list => [qw/NONE AND XOR OR Exclusive Inclusive Parallel Complex/] }, - }, + }, split_type_exclusive => { data_type => 'ENUM', is_nullable => 1, default => 'Data', default_value => 'Data', - extra => { - list => [qw/Data Event/] + extra => { + list => [qw/Data Event/] }, - }, + }, event_attr => { data_type => 'TEXT', is_nullable => 1, @@ -168,17 +168,17 @@ __PACKAGE__->add_columns( data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, assignments => { data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, extended_attr => { data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, ); __PACKAGE__->set_primary_key('activity_id'); @@ -191,14 +191,14 @@ __PACKAGE__->belongs_to( # transitions __PACKAGE__->has_many( - transitions_in => 'BPM::Engine::Store::Result::Transition', + transitions_in => 'BPM::Engine::Store::Result::Transition', { 'foreign.to_activity_id' => 'self.activity_id' } ); __PACKAGE__->many_to_many( prev_activities => 'transitions_in', 'from_activity' ); __PACKAGE__->has_many( - transitions => 'BPM::Engine::Store::Result::Transition', + transitions => 'BPM::Engine::Store::Result::Transition', { 'foreign.from_activity_id' => 'self.activity_id' } ); __PACKAGE__->many_to_many( @@ -246,11 +246,11 @@ sub new { sub store_column { my ($self, $name, $value) = @_; - + if ($name eq 'activity_uid') { $value = join( '_', split( /\s+/, $value ) ); #lc? } - + $self->next::method( $name, $value ); } @@ -282,7 +282,7 @@ sub transitions_in_by_ref { sub transitions_by_ref { my ($self) = @_; - + return $self->result_source->schema->resultset('Transition')->search( { 'me.from_activity_id' => $self->id, 'transition_refs.split_or_join' => 'SPLIT', @@ -294,12 +294,12 @@ sub transitions_by_ref { sub is_start_activity { my $self = shift; - #$g->is_source_vertex($v) + #$g->is_source_vertex($v) return $self->transitions_in->count == 0 ? 1 : 0; } sub is_end_activity { - my $self = shift; + my $self = shift; #$g->is_sink_vertex($v) return $self->transitions->count == 0 ? 1 : 0; } @@ -386,7 +386,7 @@ sub is_complex_join { #-- implementation_type shortcuts (No Tool Task SubFlow Reference) -sub is_impl_no { +sub is_impl_no { shift->implementation_type =~ /^no$/i ? 1 : 0; } diff --git a/lib/BPM/Engine/Store/Result/ActivityDeadline.pm b/lib/BPM/Engine/Store/Result/ActivityDeadline.pm index c261b69..fdf2d27 100644 --- a/lib/BPM/Engine/Store/Result/ActivityDeadline.pm +++ b/lib/BPM/Engine/Store/Result/ActivityDeadline.pm @@ -26,20 +26,20 @@ __PACKAGE__->add_columns( exception_id => { data_type => 'INT', is_foreign_key => 1, - is_nullable => 0, - }, + is_nullable => 0, + }, execution => { data_type => 'ENUM', is_nullable => 0, default => 'SYNCHR', default_value => 'SYNCHR', extra => { list => [qw/ SYNCHR ASYNCHR /] }, - }, + }, duration => { data_type => 'VARCHAR', size => 64, is_nullable => 1, - }, + }, ); __PACKAGE__->set_primary_key(qw/ deadline_id /); diff --git a/lib/BPM/Engine/Store/Result/ActivityInstance.pm b/lib/BPM/Engine/Store/Result/ActivityInstance.pm index 1c708b7..2d91132 100644 --- a/lib/BPM/Engine/Store/Result/ActivityInstance.pm +++ b/lib/BPM/Engine/Store/Result/ActivityInstance.pm @@ -34,18 +34,18 @@ __PACKAGE__->add_columns( process_instance_id => { data_type => 'INT', extras => { unsigned => 1 }, - is_foreign_key => 1, + is_foreign_key => 1, is_nullable => 0, }, activity_id => { # process state data_type => 'INT', - is_foreign_key => 1, + is_foreign_key => 1, is_nullable => 0, extras => { unsigned => 1 }, }, transition_id => { # the transition this instance is a result of data_type => 'INT', - is_foreign_key => 1, + is_foreign_key => 1, is_nullable => 1, }, prev => { # the activity instance this instance was derived from @@ -66,7 +66,7 @@ __PACKAGE__->add_columns( is_nullable => 1, extras => { unsigned => 1 }, size => 11, - }, + }, inputset => { data_type => 'TEXT', is_nullable => 1, @@ -76,12 +76,12 @@ __PACKAGE__->add_columns( data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, taskresult => { data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, created => { data_type => 'DATETIME', is_nullable => 1, @@ -97,7 +97,7 @@ __PACKAGE__->add_columns( data_type => 'DATETIME', is_nullable => 1, timezone => 'UTC', - }, + }, ); __PACKAGE__->set_primary_key(qw/ token_id /); @@ -109,7 +109,7 @@ __PACKAGE__->belongs_to( # state __PACKAGE__->belongs_to( - activity => 'BPM::Engine::Store::Result::Activity', 'activity_id' + activity => 'BPM::Engine::Store::Result::Activity', 'activity_id' ); # the transition this instance is a result of @@ -138,7 +138,7 @@ __PACKAGE__->has_many( ); __PACKAGE__->might_have( - 'split' => 'BPM::Engine::Store::Result::ActivityInstanceSplit', + 'split' => 'BPM::Engine::Store::Result::ActivityInstanceSplit', { 'foreign.token_id' => 'self.token_id' } ); @@ -159,17 +159,17 @@ __PACKAGE__->has_many( sub insert { my ($self, @args) = @_; - + my $guard = $self->result_source->schema->txn_scope_guard; - + $self->next::method(@args); $self->discard_changes; - + my $state = $self->create_related('state_events', { state => $self->workflow->get_state($self->workflow->initial_state), - }); - $self->update({ workflow_instance_id => $state->id }); - + }); + $self->update({ workflow_instance_id => $state->id }); + $guard->commit; return $self; @@ -186,25 +186,25 @@ sub is_deferred { } sub is_completed { - my $self = shift; - return $self->completed ? 1 : 0; + my $self = shift; + return $self->completed ? 1 : 0; } sub TO_JSON { my ($self, $level) = @_; - + my %struct = map { $_ => $self->$_ } grep { $self->$_ } (qw/ token_id parent_token_id process_instance_id activity_id - transition_id workflow_instance_id tokenset + transition_id workflow_instance_id tokenset taskresult created deferred completed state - /); # taskdata inputset # - + /); # taskdata inputset # + #foreach my $rel(qw/workitems attributes prev next/) { # activity # $struct{$rel} = $self->$rel; # } - + return \%struct; } diff --git a/lib/BPM/Engine/Store/Result/ActivityInstanceAttribute.pm b/lib/BPM/Engine/Store/Result/ActivityInstanceAttribute.pm index 9ccf73f..1ef6a09 100644 --- a/lib/BPM/Engine/Store/Result/ActivityInstanceAttribute.pm +++ b/lib/BPM/Engine/Store/Result/ActivityInstanceAttribute.pm @@ -13,11 +13,11 @@ __PACKAGE__->table('wfe_activity_instance_attr'); __PACKAGE__->add_columns( activity_instance_id => { data_type => 'INT', - is_nullable => 0, + is_nullable => 0, size => 11, is_foreign_key => 1, extras => { unsigned => 1 }, - }, + }, name => { data_type => 'VARCHAR', size => 64, @@ -42,7 +42,7 @@ __PACKAGE__->add_columns( __PACKAGE__->set_primary_key(qw/ activity_instance_id name /); __PACKAGE__->belongs_to( - activity_instance => 'BPM::Engine::Store::Result::ActivityInstance', + activity_instance => 'BPM::Engine::Store::Result::ActivityInstance', 'activity_instance_id' ); diff --git a/lib/BPM/Engine/Store/Result/ActivityInstanceSplit.pm b/lib/BPM/Engine/Store/Result/ActivityInstanceSplit.pm index 2ac2e50..9af5e1c 100644 --- a/lib/BPM/Engine/Store/Result/ActivityInstanceSplit.pm +++ b/lib/BPM/Engine/Store/Result/ActivityInstanceSplit.pm @@ -35,7 +35,7 @@ __PACKAGE__->add_columns( fired_count => { data_type => 'INT', default_value => 0, - is_nullable => 0, + is_nullable => 0, size => 6, extras => { unsigned => 1 }, }, @@ -43,7 +43,7 @@ __PACKAGE__->add_columns( data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, ); __PACKAGE__->set_primary_key(qw/ split_id /); @@ -54,18 +54,18 @@ __PACKAGE__->belongs_to( 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 '" . + 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'"); } - + $states->{$transition_id} = $state || 'taken'; $self->states($states); $self->update->discard_changes(); @@ -80,13 +80,13 @@ sub should_fire { "' doesn't match transition " . $transition->transition_uid . " activity '" . $transition->from_activity->activity_uid . "'"); } - + $self->set_transition($transition->id, 'joined') unless $no_update; $self->discard_changes(); - + my $states = $self->states; - die("Transition " . $transition->transition_uid . " not taken") - unless $states->{$transition->id}; + die("Transition " . $transition->transition_uid . " not taken") + unless $states->{$transition->id}; my @followed = grep { $states->{$_} eq 'joined' } keys %{$states}; return 0 if scalar @followed != scalar keys %{$self->states}; diff --git a/lib/BPM/Engine/Store/Result/ActivityInstanceState.pm b/lib/BPM/Engine/Store/Result/ActivityInstanceState.pm index 84bb86c..491f982 100644 --- a/lib/BPM/Engine/Store/Result/ActivityInstanceState.pm +++ b/lib/BPM/Engine/Store/Result/ActivityInstanceState.pm @@ -1,4 +1,4 @@ -package BPM::Engine::Store::Result::ActivityInstanceState; +package BPM::Engine::Store::Result::ActivityInstanceState; BEGIN { $BPM::Engine::Store::Result::ActivityInstanceState::VERSION = '0.001'; $BPM::Engine::Store::Result::ActivityInstanceState::AUTHORITY = 'cpan:SITETECH'; @@ -40,7 +40,7 @@ __PACKAGE__->add_columns( prev => { data_type => 'INT', is_nullable => 1, - size => 11, + size => 11, }, created => { data_type => 'DATETIME', @@ -53,7 +53,7 @@ __PACKAGE__->add_columns( __PACKAGE__->set_primary_key('event_id'); __PACKAGE__->belongs_to( - activity_instance => 'BPM::Engine::Store::Result::ActivityInstance', + activity_instance => 'BPM::Engine::Store::Result::ActivityInstance', 'token_id', { cascade_delete => 0 } ); @@ -69,12 +69,12 @@ sub clone { } __PACKAGE__->inflate_column('state', { - inflate => sub { - my ($value, $self) = @_; - return $self->activity_instance->workflow->get_state($value); + inflate => sub { + my ($value, $self) = @_; + return $self->activity_instance->workflow->get_state($value); }, - deflate => sub { - shift->stringify + deflate => sub { + shift->stringify }, }); diff --git a/lib/BPM/Engine/Store/Result/ActivityTask.pm b/lib/BPM/Engine/Store/Result/ActivityTask.pm index 8cd5073..153314b 100644 --- a/lib/BPM/Engine/Store/Result/ActivityTask.pm +++ b/lib/BPM/Engine/Store/Result/ActivityTask.pm @@ -29,7 +29,7 @@ __PACKAGE__->add_columns( is_foreign_key => 1, is_nullable => 1, extras => { unsigned => 1 } - }, + }, task_uid => { data_type => 'VARCHAR', size => 64, @@ -39,12 +39,12 @@ __PACKAGE__->add_columns( data_type => 'VARCHAR', size => 64, is_nullable => 1, - }, + }, description => { data_type => 'VARCHAR', size => 255, is_nullable => 1, - }, + }, task_type => { data_type => 'ENUM', is_nullable => 1, @@ -62,17 +62,17 @@ __PACKAGE__->add_columns( actual_params => { data_type => 'TEXT', is_nullable => 1, - serializer_class => 'JSON', + serializer_class => 'JSON', }, data_maps => { data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, extended_attr => { data_type => 'TEXT', is_nullable => 1, - serializer_class => 'JSON', + serializer_class => 'JSON', }, ); __PACKAGE__->set_primary_key(qw/ task_id /); diff --git a/lib/BPM/Engine/Store/Result/Application.pm b/lib/BPM/Engine/Store/Result/Application.pm index b76ebf2..b88fa0e 100644 --- a/lib/BPM/Engine/Store/Result/Application.pm +++ b/lib/BPM/Engine/Store/Result/Application.pm @@ -16,7 +16,7 @@ __PACKAGE__->add_columns( is_auto_increment => 1, is_nullable => 0, extras => { unsigned => 1 } - }, + }, application_uid => { data_type => 'VARCHAR', size => 64, @@ -44,7 +44,7 @@ __PACKAGE__->add_columns( size => 36, is_nullable => 0, is_foreign_key => 1, - }, + }, formal_params => { data_type => 'TEXT', is_nullable => 1, @@ -54,7 +54,7 @@ __PACKAGE__->add_columns( data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, ); __PACKAGE__->set_primary_key(qw/ application_id /); diff --git a/lib/BPM/Engine/Store/Result/Package.pm b/lib/BPM/Engine/Store/Result/Package.pm index e2440d4..a0b2fe5 100644 --- a/lib/BPM/Engine/Store/Result/Package.pm +++ b/lib/BPM/Engine/Store/Result/Package.pm @@ -18,7 +18,7 @@ __PACKAGE__->add_columns( #size => 16, is_nullable => 0, default_value => 'xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx', - }, + }, package_uid => { data_type => 'VARCHAR', size => 64, @@ -33,7 +33,7 @@ __PACKAGE__->add_columns( data_type => 'VARCHAR', size => 8, is_nullable => 1, - }, + }, specification => { data_type => 'VARCHAR', size => 20, @@ -76,7 +76,7 @@ __PACKAGE__->add_columns( data_type => 'ENUM', is_nullable => 0, default => 'UNDER_REVISION', - default_value => 'UNDER_REVISION', # sqlite + default_value => 'UNDER_REVISION', # sqlite extra => { list => [qw/UNDER_REVISION RELEASED UNDER_TEST/] }, }, description => { @@ -128,12 +128,12 @@ __PACKAGE__->add_columns( data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, extended_attr => { data_type => 'TEXT', is_nullable => 1, serializer_class => 'JSON', - }, + }, ); __PACKAGE__->set_primary_key('package_id'); @@ -145,7 +145,7 @@ __PACKAGE__->has_many( __PACKAGE__->has_many( participants => 'BPM::Engine::Store::Result::Participant', - { 'foreign.parent_node' => 'self.package_id' }, + { 'foreign.parent_node' => 'self.package_id' }, { where => { participant_scope => 'Package' } } ); diff --git a/lib/BPM/Engine/Store/Result/Participant.pm b/lib/BPM/Engine/Store/Result/Participant.pm index 50d5572..b586b79 100644 --- a/lib/BPM/Engine/Store/Result/Participant.pm +++ b/lib/BPM/Engine/Store/Result/Participant.pm @@ -47,13 +47,13 @@ __PACKAGE__->add_columns( default => 'Package', default_value => 'Package', extra => { list => [qw/ Package Process /] }, - }, + }, parent_node => { data_type => 'CHAR', size => 36, is_nullable => 0, is_foreign_key => 1, - }, + }, attributes => { data_type => 'TEXT', is_nullable => 1, diff --git a/lib/BPM/Engine/Store/Result/Performer.pm b/lib/BPM/Engine/Store/Result/Performer.pm index 81da60b..83b2022 100644 --- a/lib/BPM/Engine/Store/Result/Performer.pm +++ b/lib/BPM/Engine/Store/Result/Performer.pm @@ -35,7 +35,7 @@ __PACKAGE__->add_columns( default => 'Activity', default_value => 'Activity', extra => { list => [qw/ Activity Task Lane /] }, - }, + }, ); __PACKAGE__->set_primary_key('performer_id'); diff --git a/lib/BPM/Engine/Store/Result/Process.pm b/lib/BPM/Engine/Store/Result/Process.pm index cd4bb94..5e80543 100644 --- a/lib/BPM/Engine/Store/Result/Process.pm +++ b/lib/BPM/Engine/Store/Result/Process.pm @@ -167,7 +167,7 @@ sub TO_JSON { if($self->created) { $params{created} = $self->created->TO_JSON; #->ymd; } - + return \%params; } diff --git a/lib/BPM/Engine/Store/Result/ProcessInstance.pm b/lib/BPM/Engine/Store/Result/ProcessInstance.pm index 48042a2..6d4a57b 100644 --- a/lib/BPM/Engine/Store/Result/ProcessInstance.pm +++ b/lib/BPM/Engine/Store/Result/ProcessInstance.pm @@ -28,7 +28,7 @@ __PACKAGE__->add_columns( size => 36, is_nullable => 0, is_foreign_key => 1, - }, + }, parent_ai_id => { # parent blockactivity data_type => 'INT', is_nullable => 1, @@ -108,7 +108,7 @@ sub insert { sub TO_JSON { my $self = shift; my $fields = { - map { $_ => $self->$_() } + map { $_ => $self->$_() } qw/instance_id process_id instance_name created completed/ }; # $fields->{attributes} = [ map { $_->TO_JSON } $self->attributes_rs->all ]; diff --git a/lib/BPM/Engine/Store/Result/ProcessInstanceAttribute.pm b/lib/BPM/Engine/Store/Result/ProcessInstanceAttribute.pm index 2edb5f1..392e124 100644 --- a/lib/BPM/Engine/Store/Result/ProcessInstanceAttribute.pm +++ b/lib/BPM/Engine/Store/Result/ProcessInstanceAttribute.pm @@ -38,7 +38,7 @@ __PACKAGE__->add_columns( default_value => 'INOUT', extra => { list => [qw/IN OUT INOUT/] }, }, - type => { + type => { data_type => 'ENUM', is_nullable => 0, default => 'BasicType', @@ -102,7 +102,7 @@ sub new { sub validate { my ($self, $value) = @_; - + throw_abstract error => 'BlockActivity not implemented yet'; } @@ -112,13 +112,13 @@ sub value { if($newvalue) { my $name = $self->name; die("Attribute '$name' is read-only") if($self->is_readonly); - die("Attribute value $newvalue should be a reference") + die("Attribute value $newvalue should be a reference") unless(ref($newvalue)); return $self->_value($newvalue); } my $value = $self->_value; - return ($self->type eq 'BasicType' && !$self->is_array) ? + return ($self->type eq 'BasicType' && !$self->is_array) ? $value->[0] : $value; } diff --git a/lib/BPM/Engine/Store/Result/ProcessInstanceState.pm b/lib/BPM/Engine/Store/Result/ProcessInstanceState.pm index 3b77314..07f5d9d 100644 --- a/lib/BPM/Engine/Store/Result/ProcessInstanceState.pm +++ b/lib/BPM/Engine/Store/Result/ProcessInstanceState.pm @@ -42,20 +42,20 @@ __PACKAGE__->add_columns( prev => { data_type => 'INT', is_nullable => 1, - size => 11, + size => 11, }, created => { data_type => 'DATETIME', is_nullable => 1, set_on_create => 1, timezone => 'UTC', - }, + }, ); __PACKAGE__->set_primary_key('event_id'); __PACKAGE__->belongs_to( - process_instance => 'BPM::Engine::Store::Result::ProcessInstance', + process_instance => 'BPM::Engine::Store::Result::ProcessInstance', 'process_instance_id' ); diff --git a/lib/BPM/Engine/Store/Result/Transition.pm b/lib/BPM/Engine/Store/Result/Transition.pm index 6bfd18d..6c965cb 100644 --- a/lib/BPM/Engine/Store/Result/Transition.pm +++ b/lib/BPM/Engine/Store/Result/Transition.pm @@ -20,13 +20,13 @@ __PACKAGE__->add_columns( is_auto_increment => 1, is_nullable => 0, extras => { unsigned => 1 } - }, + }, process_id => { data_type => 'CHAR', size => 36, is_nullable => 0, is_foreign_key => 1, - }, + }, from_activity_id => { # state data_type => 'INT', is_nullable => 0, @@ -36,7 +36,7 @@ __PACKAGE__->add_columns( data_type => 'INT', is_nullable => 0, is_foreign_key => 1, - }, + }, transition_uid => { data_type => 'VARCHAR', size => 64, @@ -60,23 +60,23 @@ __PACKAGE__->add_columns( extra => { list => [qw/ NONE CONDITION OTHERWISE EXCEPTION DEFAULTEXCEPTION /] }, - }, + }, condition_expr => { data_type => 'TEXT', is_nullable => 1, }, quantity => { data_type => 'INT', - default_value => 1, + default_value => 1, size => 3, is_nullable => 1, - }, + }, assignments => { data_type => 'TEXT', #size => 255, is_nullable => 1, serializer_class => 'JSON', - }, + }, class => { data_type => 'VARCHAR', size => 255, @@ -88,7 +88,7 @@ __PACKAGE__->add_columns( is_nullable => 1, size => 1, extras => { unsigned => 1 } - }, + }, ); __PACKAGE__->set_primary_key('transition_id'); @@ -97,17 +97,17 @@ __PACKAGE__->add_unique_constraint( [qw/process_id from_activity_id to_activity_id/] ); -__PACKAGE__->belongs_to( +__PACKAGE__->belongs_to( process => 'BPM::Engine::Store::Result::Process', 'process_id' ); -__PACKAGE__->belongs_to( +__PACKAGE__->belongs_to( from_activity => 'BPM::Engine::Store::Result::Activity', { 'foreign.activity_id' => 'self.from_activity_id' } ); __PACKAGE__->belongs_to( - to_activity => 'BPM::Engine::Store::Result::Activity', + to_activity => 'BPM::Engine::Store::Result::Activity', { 'foreign.activity_id' => 'self.to_activity_id' } ); @@ -118,22 +118,22 @@ __PACKAGE__->has_many( __PACKAGE__->might_have( deadline => 'BPM::Engine::Store::Result::ActivityDeadline', - { 'foreign.exception_id' => 'self.transition_id' } + { 'foreign.exception_id' => 'self.transition_id' } ); __PACKAGE__->meta->make_immutable( inline_constructor => 0 ); sub from_split { my $self = shift; - return $self->transition_refs({ - activity_id => $self->from_activity_id + return $self->transition_refs({ + activity_id => $self->from_activity_id })->first; } sub to_join { my $self = shift; - return $self->transition_refs({ - activity_id => $self->to_activity_id + return $self->transition_refs({ + activity_id => $self->to_activity_id })->first; } diff --git a/lib/BPM/Engine/Store/Result/TransitionRef.pm b/lib/BPM/Engine/Store/Result/TransitionRef.pm index 43ca33d..fc33284 100644 --- a/lib/BPM/Engine/Store/Result/TransitionRef.pm +++ b/lib/BPM/Engine/Store/Result/TransitionRef.pm @@ -27,14 +27,14 @@ __PACKAGE__->add_columns( extra => { list => [qw/ SPLIT JOIN /] }, - }, + }, position => { data_type => 'TINYINT', default_value => 0, is_nullable => 0, size => 3, extras => { unsigned => 1 } - }, + }, ); __PACKAGE__->set_primary_key(qw/ activity_id transition_id split_or_join /); diff --git a/lib/BPM/Engine/Store/Result/WorkItem.pm b/lib/BPM/Engine/Store/Result/WorkItem.pm index 7d9ebd2..9ae06f0 100644 --- a/lib/BPM/Engine/Store/Result/WorkItem.pm +++ b/lib/BPM/Engine/Store/Result/WorkItem.pm @@ -22,7 +22,7 @@ __PACKAGE__->add_columns( data_type => 'VARCHAR', size => 64, is_nullable => 1, - }, + }, parent_id => { data_type => 'INT', extras => { unsigned => 1 }, @@ -34,31 +34,31 @@ __PACKAGE__->add_columns( size => 36, is_nullable => 0, is_foreign_key => 1, - }, + }, process_instance_id => { data_type => 'INT', is_foreign_key => 1, is_nullable => 0, extras => { unsigned => 1 }, - }, + }, activity_id => { data_type => 'INT', extras => { unsigned => 1 }, is_foreign_key => 1, is_nullable => 0, - }, + }, token_id => { data_type => 'INT', extras => { unsigned => 1 }, is_foreign_key => 1, is_nullable => 0, - }, + }, participant_id => { data_type => 'INT', extras => { unsigned => 1 }, is_foreign_key => 1, is_nullable => 0, - }, + }, status => { data_type => 'VARCHAR', size => 20, @@ -85,7 +85,7 @@ __PACKAGE__->belongs_to( process => 'BPM::Engine::Store::Result::Process', 'process_id' ); __PACKAGE__->belongs_to( - process_instance => 'BPM::Engine::Store::Result::ProcessInstance', + process_instance => 'BPM::Engine::Store::Result::ProcessInstance', { 'foreign.instance_id' => 'self.process_instance_id' } ); __PACKAGE__->belongs_to( diff --git a/lib/BPM/Engine/Store/ResultBase/Activity.pm b/lib/BPM/Engine/Store/ResultBase/Activity.pm index b7ab619..477d416 100644 --- a/lib/BPM/Engine/Store/ResultBase/Activity.pm +++ b/lib/BPM/Engine/Store/ResultBase/Activity.pm @@ -15,16 +15,16 @@ with qw/ sub new_instance { my ($self, $args) = @_; - + my $guard = $self->result_source->schema->txn_scope_guard; - + my $ai = $self->add_to_instances($args); if($self->is_split) { $ai->create_related('split', { states => {} }); } - + $guard->commit; - + #$ai->discard_changes; return $ai; } diff --git a/lib/BPM/Engine/Store/ResultBase/ActivityInstance.pm b/lib/BPM/Engine/Store/ResultBase/ActivityInstance.pm index 12f4d70..683a94f 100644 --- a/lib/BPM/Engine/Store/ResultBase/ActivityInstance.pm +++ b/lib/BPM/Engine/Store/ResultBase/ActivityInstance.pm @@ -46,7 +46,7 @@ workflow: - name : reassign to_state: open.running.assigned - name : unassign - to_state: open.running.not_assigned + to_state: open.running.not_assigned - name : suspend to_state: open.not_running.suspended - name : abort diff --git a/lib/BPM/Engine/Store/ResultBase/Process.pm b/lib/BPM/Engine/Store/ResultBase/Process.pm index 9d54fef..3447451 100644 --- a/lib/BPM/Engine/Store/ResultBase/Process.pm +++ b/lib/BPM/Engine/Store/ResultBase/Process.pm @@ -10,11 +10,11 @@ use Moose::Role; sub new_instance { my ($self, $attrs) = @_; $attrs ||= {}; - - my $guard = $self->result_source->schema->txn_scope_guard; + + my $guard = $self->result_source->schema->txn_scope_guard; my $process_instance = $self->add_to_instances($attrs); - + if(my $package = $self->package) { $process_instance->create_attributes('container', $package->data_fields) if $package->data_fields; @@ -23,9 +23,9 @@ sub new_instance { if $self->data_fields; $process_instance->create_attributes('params', $self->formal_params) if $self->formal_params; - + $guard->commit; - + return $process_instance; } @@ -46,16 +46,16 @@ sub start_activity { sub mark_back_edges { my $self = shift; - + my $g = $self->graph; return unless $g->is_cyclic; - + $g = $g->copy_graph; #warn "Graph: ", $g->stringify(), "\n"; my @v = sort $g->vertices(); my @sources = $g->source_vertices(); my $start = $sources[0]; # $self->start_activity->id; - + # find and remove all cycles while( my @cyc = $g->find_a_cycle() ) { my $apsp = $g->APSP_Floyd_Warshall(); @@ -65,17 +65,17 @@ sub mark_back_edges { CYC: for my $v(@cyc) { next if $v eq $far; next unless $g->has_edge($far,$v); - + $self->transitions({ from_activity_id => $far, to_activity_id => $v }) ->first->update({ is_back_edge => 1 }); - + # Remove edge (${far}->$v) $g->delete_edge($far,$v); $g->add_edge($v,$far); #warn "Graph is now: " . $g->stringify(); last CYC; } - + } } diff --git a/lib/BPM/Engine/Store/ResultBase/ProcessTransition.pm b/lib/BPM/Engine/Store/ResultBase/ProcessTransition.pm index 7bcc4d2..3c0cc08 100644 --- a/lib/BPM/Engine/Store/ResultBase/ProcessTransition.pm +++ b/lib/BPM/Engine/Store/ResultBase/ProcessTransition.pm @@ -27,31 +27,31 @@ sub apply { }, @args, ); - + return wantarray ? ($new_instance, @rv) : $new_instance; } sub _apply_body { my ($self, $instance, @args) = @_; - + return {}, (); # no fields, no additional values } sub derive_and_accept_instance { my ($self, $proto_instance, $attrs, @args) = @_; - my $activity = delete $attrs->{activity} + my $activity = delete $attrs->{activity} or die "You must specify the next activity of the instance"; - my $from_activity = $self->from_activity; + my $from_activity = $self->from_activity; if($from_activity->split_type ne 'NONE') { # set transition 'taken' if coming from a split my $split = $proto_instance->split or die("No join found for split " . $from_activity->activity_uid); $split->set_transition($self->id, 'taken'); } - - # Tokens placed on downstream edges keep the Tokenset of the firing Token. + + # Tokens placed on downstream edges keep the Tokenset of the firing Token. # Tokens placed on upstream edges on the other hand will each be created in # the context of a new Tokenset. if($self->is_back_edge) { # upstream (start new cycle loop) @@ -60,7 +60,7 @@ sub derive_and_accept_instance { else { $attrs->{tokenset} = $proto_instance->parent_token_id; } - + return $activity->new_instance({ process_instance_id => $proto_instance->process_instance_id, prev => $proto_instance->id, diff --git a/lib/BPM/Engine/Store/ResultRole/ActivityInstanceJoin.pm b/lib/BPM/Engine/Store/ResultRole/ActivityInstanceJoin.pm index 22c296f..b3f4e3c 100644 --- a/lib/BPM/Engine/Store/ResultRole/ActivityInstanceJoin.pm +++ b/lib/BPM/Engine/Store/ResultRole/ActivityInstanceJoin.pm @@ -11,8 +11,8 @@ use BPM::Engine::Exceptions qw/throw_abstract/; sub is_enabled { my $self = shift; - #warn("Not an active instance") unless $self->is_active; - + #warn("Not an active instance") unless $self->is_active; + my $activity = $self->activity; if(!$activity->is_join) { die("Not a join " . $activity->activity_uid); @@ -68,7 +68,7 @@ sub _or_join_should_fire { 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. @@ -77,30 +77,30 @@ sub _or_join_should_fire { 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 +# 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 $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} + if( $split->states->{$trans->id} && $split->states->{$trans->id} eq 'blocked') { # no blocking if followed a backedge upstream (cyclic wf) - my @tids = - map { $_->id } + my @tids = + map { $_->id } $ai->activity->transitions({ is_back_edge => 1 })->all; if(scalar @tids) { return 0 if $ai->next({ transition_id => [@tids] })->count; @@ -111,15 +111,15 @@ sub _upstream_blocked { return 0; } }; - + my $seen = 0; my $block = 0; - + my(@act) = ([$transition->from_activity, $transition]); while(my $next = shift(@act)) { my ($upstream_act, $down_trans) = ($next->[0], $next->[1]); my @ai = $rs->search({'activity_id' => $upstream_act->id})->all; - + # no activity instances, traverse further upstream if(!scalar @ai) { foreach my $trans($upstream_act->transitions_in) { @@ -134,11 +134,11 @@ sub _upstream_blocked { else { $seen++; my %status = (); - foreach(@ai) { + foreach(@ai) { $status{ - $_->is_deferred ? 'deferred' : - ($_->is_completed ? 'completed' : 'active') - }++; + $_->is_deferred ? 'deferred' : + ($_->is_completed ? 'completed' : 'active') + }++; } die("Invalid db state for instances " . $upstream_act->activity_uid) @@ -154,11 +154,11 @@ sub _upstream_blocked { 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; + 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") + die("OR split " . $upstream_act->activity_uid . " completed but not blocked") unless $blocked; } elsif(!$upstream_act->is_xor_split) { @@ -177,7 +177,7 @@ sub _upstream_blocked { sub fire_join { my $self = shift; - + die("Not a join") unless $self->activity->is_join; die("Not active") unless $self->is_active; @@ -208,7 +208,7 @@ sub _mark_upstream_joined { # traverse upstream while($upstream_ai = $self->prev) { delete $open_reach->{$upstream_ai->activity->id}; - + if($upstream_ai->activity->is_or_split) { if($upstream_ai->activity->id != $transition->from_activity->id) { die("ShouldFire: Illegal transition for JoinActivity '" . @@ -217,16 +217,16 @@ sub _mark_upstream_joined { " activity '" . $transition->from_activity->activity_uid . "'"); } - my $split = $upstream_ai->split + my $split = $upstream_ai->split || die("Inclusive split has no join attached"); $split->discard_changes; - + # mark transition from split as 'fired' in join from this downstream branch my $should_fire = $split->should_fire($transition); - + return 0 unless($is_parent || $should_fire); } - + $is_parent = 0; $self = $upstream_ai; $transition = $upstream_ai->transition; diff --git a/lib/BPM/Engine/Store/ResultRole/TransitionCondition.pm b/lib/BPM/Engine/Store/ResultRole/TransitionCondition.pm index 75f8659..ef31f29 100644 --- a/lib/BPM/Engine/Store/ResultRole/TransitionCondition.pm +++ b/lib/BPM/Engine/Store/ResultRole/TransitionCondition.pm @@ -27,7 +27,7 @@ before apply => sub { my $state = $instance->activity; unless ($state->has_transition($self)) { - die($self->transition_uid . ' is not in ' . + die($self->transition_uid . ' is not in ' . $instance->activity->activity_uid . '\'s current state'); } @@ -58,27 +58,27 @@ before apply => sub { around apply => sub { my $next = shift; my ($self, $instance, @args) = @_; - + $self->validate($instance, @args); - + return $self->$next($instance, @args); }; sub validate { my ($self, $instance, @args) = @_; - + foreach my $validator($self->all_validators) { my $ok = eval { $self->$validator($instance, @args) }; my $error = $@; if($error) { - is_Exception($error) ? + is_Exception($error) ? $error->rethrow() : throw_expression(error => $error); } elsif(!$ok) { throw_condition error => 'Condition (boolean) false'; } } - + return 1; } diff --git a/lib/BPM/Engine/Store/ResultRole/WithAssignments.pm b/lib/BPM/Engine/Store/ResultRole/WithAssignments.pm index c316b53..1bfc492 100644 --- a/lib/BPM/Engine/Store/ResultRole/WithAssignments.pm +++ b/lib/BPM/Engine/Store/ResultRole/WithAssignments.pm @@ -10,14 +10,14 @@ use Moose::Role; sub start_assignments { my $self = shift; my $assignments = $self->assignments || []; - return grep { !$_->{AssignTime} || $_->{AssignTime} eq 'Start' } + return grep { !$_->{AssignTime} || $_->{AssignTime} eq 'Start' } @$assignments; } sub end_assignments { my $self = shift; my $assignments = $self->assignments || []; - return grep { $_->{AssignTime} eq 'End' } + return grep { $_->{AssignTime} eq 'End' } @$assignments; } diff --git a/lib/BPM/Engine/Store/ResultRole/WithAttributes.pm b/lib/BPM/Engine/Store/ResultRole/WithAttributes.pm index eda7a1e..2105b05 100644 --- a/lib/BPM/Engine/Store/ResultRole/WithAttributes.pm +++ b/lib/BPM/Engine/Store/ResultRole/WithAttributes.pm @@ -14,11 +14,11 @@ use BPM::Engine::Exceptions qw/throw_store throw_param/; sub attribute { my ($self, $name, $value) = @_; - + throw_param("Need a name") unless $name; - my $attr = $self->attributes->find({ name => $name }) + my $attr = $self->attributes->find({ name => $name }) or throw_store error => "Attribute named '$name' not found"; - + if(defined $value) { die("Attribute '$name' is read-only") if($attr->is_readonly); #$value = $attr->validate($value); @@ -28,15 +28,15 @@ sub attribute { throw_param("Attribute value not a reference") unless(ref($value)); $attr->update({ value => $value }); } - + return $attr; } sub attribute_hash { my $self = shift; - return { - map { - $_->name => $_->value + return { + map { + $_->name => $_->value } $self->attributes->all }; } @@ -44,15 +44,15 @@ sub attribute_hash { sub create_attributes { my ($self, $scope, $data_fields) = @_; - throw_param error => "Need scope and data fields" + throw_param error => "Need scope and data fields" unless($scope && $data_fields && ref($data_fields) eq 'ARRAY'); - + my $expr = BPM::Engine::Util::ExpressionEvaluator->load( process => $self->process, process_instance => ref($self) =~ /Activity/ ? $self->process_instance : $self, ); - + my $build_value = sub { my $init = shift || {}; ## no critic (ProhibitExplicitReturnUndef) @@ -67,7 +67,7 @@ sub create_attributes { else { $ivalue = $expr->render($ivalue); } - + return $ivalue; }; @@ -93,9 +93,9 @@ sub create_attributes { value => $value, }); } - + $guard->commit; - + return; } diff --git a/lib/BPM/Engine/Store/ResultRole/WithWorkflow.pm b/lib/BPM/Engine/Store/ResultRole/WithWorkflow.pm index 6af826c..507b3bf 100644 --- a/lib/BPM/Engine/Store/ResultRole/WithWorkflow.pm +++ b/lib/BPM/Engine/Store/ResultRole/WithWorkflow.pm @@ -50,16 +50,16 @@ sub _workflow_txn { # pass the current workflow instance to the closure, and if # the closure returns a valid instance, store it in the object my $new_instance = eval { $self->$sub($self->workflow_instance) }; - + if (defined $new_instance) { $self->workflow_instance($new_instance); $self->update; } - elsif ($@) { + elsif ($@) { die $@; } - else { - die "$sub did not return a new workflow instance"; + else { + die "$sub did not return a new workflow instance"; } }); } diff --git a/lib/BPM/Engine/Store/ResultSet/ActivityInstance.pm b/lib/BPM/Engine/Store/ResultSet/ActivityInstance.pm index 3c28462..6160941 100644 --- a/lib/BPM/Engine/Store/ResultSet/ActivityInstance.pm +++ b/lib/BPM/Engine/Store/ResultSet/ActivityInstance.pm @@ -46,7 +46,7 @@ sub TO_JSON { $instance->{uri} = '/wfcs/activities/' . $row->id; push(@instances, $instance); } - + return { total => $rs->pager->total_entries, # scalar @instances, totalResultsAvailable row_count => $rs->pager->entries_on_this_page, # totalResultsReturned diff --git a/lib/BPM/Engine/Store/ResultSet/Package.pm b/lib/BPM/Engine/Store/ResultSet/Package.pm index c6c3af8..7d84f5d 100644 --- a/lib/BPM/Engine/Store/ResultSet/Package.pm +++ b/lib/BPM/Engine/Store/ResultSet/Package.pm @@ -1,7 +1,7 @@ package BPM::Engine::Store::ResultSet::Package; BEGIN { $BPM::Engine::Store::ResultSet::Package::VERSION = '0.001'; - $BPM::Engine::Store::ResultSet::Package::AUTHORITY = 'cpan:SITETECH'; + $BPM::Engine::Store::ResultSet::Package::AUTHORITY = 'cpan:SITETECH'; } use namespace::autoclean; @@ -22,7 +22,7 @@ sub create_from_xml { my ($self, $arg) = @_; $arg = xml_hash($arg) unless(ref($arg) eq 'HASH'); - + return $self->_create_from_hash($arg); } @@ -30,7 +30,7 @@ sub create_from_xpdl { my ($self, $arg) = @_; $arg = xpdl_hash($arg) unless(ref($arg) eq 'HASH'); - + return $self->_create_from_hash($arg); } @@ -39,7 +39,7 @@ sub _create_from_hash { %APPMAP = (); my $schema = $self->result_source->schema; - + my $create_txn = sub { #-- main element: Package my $entry = $self->create( { @@ -49,7 +49,7 @@ sub _create_from_hash { $entry->package_name($args->{Name}) if($args->{Name}); #-- element: PackageHeader (required) - _import_packhead($entry, $args->{PackageHeader}) + _import_packhead($entry, $args->{PackageHeader}) if $args->{PackageHeader}; #-- element: RedefinableHeader @@ -57,7 +57,7 @@ sub _create_from_hash { if $args->{RedefinableHeader}; #-- element: ConformanceClass - $entry->graph_conformance($args->{ConformanceClass}->{GraphConformance}) + $entry->graph_conformance($args->{ConformanceClass}->{GraphConformance}) if ($args->{ConformanceClass}); #-- element: Script @@ -65,17 +65,17 @@ sub _create_from_hash { #-- element: TypeDeclarations #-- element: Participants - _import_participants($entry, $args->{Participants}->{Participant}) + _import_participants($entry, $args->{Participants}->{Participant}) if $args->{Participants}; #-- element: Applications - _import_applications($entry, $args->{Applications}->{Application}) + _import_applications($entry, $args->{Applications}->{Application}) if $args->{Applications}; #-- elements: DataFields, ExtendedAttributes, Formal/ActualParameters if($args->{Artifacts} && $args->{Artifacts}->{seq_Artifact}) { $args->{Artifacts}->{Artifact} = [ - map { $_->{Artifact} } + map { $_->{Artifact} } grep { $_->{Artifact}->{ArtifactType} eq 'DataObject' } @{ $args->{Artifacts}->{seq_Artifact} } ]; @@ -85,7 +85,7 @@ sub _create_from_hash { _set_elements($entry, $args); #-- element: WorkflowProcesses - _import_processes($entry, $args->{WorkflowProcesses}->{WorkflowProcess}) + _import_processes($entry, $args->{WorkflowProcesses}->{WorkflowProcess}) if $args->{WorkflowProcesses}; $entry->update(); @@ -147,18 +147,18 @@ sub _import_participants { foreach my $part_proto(@{$args}) { my $pid = delete $part_proto->{Id}; - my $participant = + my $participant = $entry->result_source->schema->resultset('Participant')->create({ participant_uid => $pid, participant_name => delete $part_proto->{Name} || $pid, description => delete $part_proto->{Description}, participant_type => $part_proto->{ParticipantType}->{Type}, - parent_node => $entry->id, + parent_node => $entry->id, participant_scope => ref($entry) =~ /Package/ ? 'Package' : 'Process', }); delete $part_proto->{ParticipantType}; - $participant->update({ attributes => $part_proto }) + $participant->update({ attributes => $part_proto }) if (keys %{$part_proto}); } @@ -167,9 +167,9 @@ sub _import_participants { sub _import_applications { my ($entry, $args) = @_; - + debug('Importing applications'); - + foreach my $app_proto(@{$args}) { my $app = _import_application($entry, $app_proto); $app->update(); @@ -198,9 +198,9 @@ sub _import_application { sub _import_processes { my ($entry, $args) = @_; - + debug('Importing processes'); - + foreach my $process(@{$args}) { _import_process($entry, $process); } @@ -210,7 +210,7 @@ sub _import_processes { sub _import_process { my ($entry, $args) = @_; - + my $process = $entry->add_to_processes({ process_uid => $args->{Id}, }); @@ -233,11 +233,11 @@ sub _import_process { _set_elements($process, $args); #-- element: Participants - _import_participants($process, $args->{Participants}->{Participant}) + _import_participants($process, $args->{Participants}->{Participant}) if $args->{Participants}; #-- element: Applications - _import_applications($process, $args->{Applications}->{Application}) + _import_applications($process, $args->{Applications}->{Application}) if $args->{Applications}; #-- element: ActivitySets @@ -258,7 +258,7 @@ sub _import_process { } #-- element: Transitions - debug('Importing transitions'); + debug('Importing transitions'); if($args->{Transitions} && $args->{Transitions}->{Transition}) { foreach my $trans_proto(@{ $args->{Transitions}->{Transition} }) { my $transition = _import_transition( @@ -268,17 +268,17 @@ sub _import_process { } } - die("Not all transitionrefs have matching transitions") + die("Not all transitionrefs have matching transitions") if(scalar keys %{$transition_map}); - die("Not all deadlines have matching transition conditions") + die("Not all deadlines have matching transition conditions") if(scalar keys %{$deadline_map}); - + #my $start_activities = $process->start_activities; #warn("Too many start activities") # if(scalar @{$start_activities} > 1); - - $process->mark_back_edges(); - + + $process->mark_back_edges(); + $process->update(); return; @@ -286,7 +286,7 @@ sub _import_process { sub _import_activity { my ($process, $args, $trans_map, $deadline_map) = @_; - + debug('Importing activity'); #-- attributes @@ -315,20 +315,20 @@ sub _import_activity { _set_elements($activity, $args); #-- element: StartMode + FinishMode - $activity->start_mode('Manual') if($args->{StartMode} && - ( ref($args->{StartMode}) ? + $activity->start_mode('Manual') if($args->{StartMode} && + ( ref($args->{StartMode}) ? $args->{StartMode}->{Manual} : ($args->{StartMode} eq 'Manual')) ); $activity->finish_mode('Manual') if($args->{FinishMode} && - ( ref($args->{FinishMode}) ? + ( ref($args->{FinishMode}) ? $args->{FinishMode}->{Manual} : ($args->{FinishMode} eq 'Manual')) ); - + #-- element: Deadline if($args->{Deadline}) { my @deadlines = @{ $args->{Deadline}->{Deadline} }; foreach my $dead(@deadlines) { - die("Illegal deadline") + die("Illegal deadline") if ($deadline_map->{$dead->{'ExceptionName'}}); $deadline_map->{$dead->{'ExceptionName'}} = { activity_id => $activity->id, @@ -341,24 +341,24 @@ sub _import_activity { #-- element: TransitionRestrictions # split_type => 'SplitType', # join_type => 'JoinType', - if($args->{TransitionRestrictions} && + if($args->{TransitionRestrictions} && $args->{TransitionRestrictions}->{TransitionRestriction}) { my @restrict = @{$args->{TransitionRestrictions}->{TransitionRestriction}}; my $seen_split = 0; - my $seen_join = 0; + my $seen_join = 0; foreach my $r(@restrict) { my @rkeys = keys %{$r}; - die("Invalid TransitionRestriction") + die("Invalid TransitionRestriction") unless(scalar(@rkeys) == 1 || scalar(@rkeys) == 2); foreach my $rtype(@rkeys) { if($rtype eq 'Split') { $activity->split_type($r->{$rtype}->{Type}); - die("Invalid TransitionRestriction: multiple splits") + die("Invalid TransitionRestriction: multiple splits") if $seen_split++; } elsif($rtype eq 'Join') { $activity->join_type($r->{$rtype}->{Type}); - die("Invalid TransitionRestriction: multiple joins") + die("Invalid TransitionRestriction: multiple joins") if $seen_join++; } else { @@ -369,7 +369,7 @@ sub _import_activity { my $pos = 1; foreach my $trans(@{ $r->{$rtype}->{TransitionRefs}->{TransitionRef} }) { $trans_map->{$trans->{Id}}->{$rtype} ||= []; - push(@{ $trans_map->{$trans->{Id}}->{$rtype} }, + push(@{ $trans_map->{$trans->{Id}}->{$rtype} }, [$activity->id, $pos++]); } } @@ -378,8 +378,8 @@ sub _import_activity { #-- element: Performer if($args->{Performers}) { - my @performers = ref($args->{Performers}->{Performer}) ? - @{$args->{Performers}->{Performer}} : + my @performers = ref($args->{Performers}->{Performer}) ? + @{$args->{Performers}->{Performer}} : ($args->{Performers}->{Performer}); _import_performers($process, $activity, @performers); } @@ -406,7 +406,7 @@ sub _import_activity { if(scalar @tkeys > 1) { die("Too many tasks (Task element takes no attributes)"); } - + $type = $tkeys[0]; if($type) { my $task = $impl->{Task}->{$type}; @@ -416,12 +416,12 @@ sub _import_activity { } } } - elsif(!$activity->is_impl_no && !$activity->is_impl_subflow + elsif(!$activity->is_impl_no && !$activity->is_impl_subflow && !$activity->is_impl_reference) { #die("Invalid Activity implementation"); } } - elsif(!$activity->is_route_type && !$activity->is_block_type + elsif(!$activity->is_route_type && !$activity->is_block_type && !$activity->is_event_type) { die("Invalid Activity implementation"); } @@ -432,24 +432,24 @@ sub _import_activity { } sub _prepare_task { - my ($type, $task) = @_; + my ($type, $task) = @_; debug('Preparing task'); - $task->{Script} = $task->{Script}->textContent + $task->{Script} = $task->{Script}->textContent if(ref($task->{Script}) eq 'XML::LibXML::Element'); # TaskApplication values for XML::LibXML::Element elements if ($type eq 'Application') { my $actual_params = delete $task->{ActualParameters}->{ActualParameter}; if($actual_params) { - $task->{ActualParameters}->{ActualParameter} = + $task->{ActualParameters}->{ActualParameter} = _mapxml($actual_params); } else { delete $task->{ActualParameters}; } - + # normalize Actual and TestValue XML::LibXML::Element elements my $maps = $task->{DataMappings}->{DataMapping}; if($maps) { @@ -462,33 +462,33 @@ sub _prepare_task { delete $task->{DataMappings}; } } - + # normalize ActualParameter values - my %msgtypes = ( - Message => 'send|receive', - MessageIn => 'user|service', + my %msgtypes = ( + Message => 'send|receive', + MessageIn => 'user|service', MessageOut => 'user|service' ); - + foreach my $msgtype(keys %msgtypes) { my $re = $msgtypes{$msgtype}; if($type =~ /$re/i) { my $msg = $task->{$msgtype}; - - my $params = $msg->{ActualParameters}->{ActualParameter}; + + my $params = $msg->{ActualParameters}->{ActualParameter}; if($params) { $msg->{ActualParameters}->{ActualParameter} = _mapxml($params); } else { delete $msg->{ActualParameters}; } - + my $dmap = $msg->{DataMappings}->{DataMapping}; if($dmap) { foreach ( @{ $msg->{DataMappings}->{DataMapping} } ) { $_->{TestValue} = _checkxml($_->{TestValue}); $_->{Actual} = _checkxml($_->{Actual}); - } + } } else { delete $msg->{DataMappings}; @@ -511,9 +511,9 @@ sub _add_task { description => delete $task->{Description} || $activity->description, task_type => $type, }) or die("Invalid Task"); - + if ($type eq 'Tool' || $type eq 'Application') { - my $app = $APPMAP{ $task->{Id} } + my $app = $APPMAP{ $task->{Id} } or die("No application for task $task->{Id}"); $task_tool->application_id($app->id); if($task->{ActualParameters}->{ActualParameter}) { @@ -527,12 +527,12 @@ sub _add_task { @{$task->{Performers}->{Performer}} : ($task->{Performers}->{Performer}); _import_performers($activity->process, $task_tool, @performers); - } + } } - + _set_elements($task_tool, $task); delete $task->{Id}; - + debug('Setting taskdata'); delete $task->{WebServiceFaultCatch}; delete $task->{ActualParameters}; @@ -547,10 +547,10 @@ sub _import_performers { debug('Importing performers'); foreach my $performer(@performers) { - die("Invalid Performer '$performer' (Missing element data)") + die("Invalid Performer '$performer' (Missing element data)") unless $performer; - my $participant = - $process->participants->find({ participant_uid => $performer }) + my $participant = + $process->participants->find({ participant_uid => $performer }) or die("Invalid Performer '$performer' (Participant unknown)"); $container->add_to_performers({ participant_id => $participant->id, @@ -562,14 +562,14 @@ sub _import_performers { sub _import_transition { my ($process, $args, $trans_map, $deadline_map) = @_; - + debug('Importing transition'); my $act_out = join( '_', split( /\s+/, $args->{From} ) ); my $act_in = join( '_', split( /\s+/, $args->{To} ) ); my $from = $process->activities->search({activity_uid => $act_out})->next or die("Unknown activity $args->{From}"); - my $to = $process->activities->search({activity_uid => $act_in })->next + my $to = $process->activities->search({activity_uid => $act_in })->next or die("Unknown activity $args->{To}"); my $transition = $process->add_to_transitions({ @@ -594,9 +594,9 @@ sub _import_transition { else { $transition->condition_type('NONE'); } - + my @exprs = $condition->getChildrenByTagName('Expression'); - my $expr = $exprs[0] || $condition; + my $expr = $exprs[0] || $condition; if(my $line = _trim($expr->textContent)) { $transition->condition_expr($line); } @@ -605,7 +605,7 @@ sub _import_transition { $transition->condition_type($args->{Condition}->{Type} || 'NONE'); $transition->condition_expr($condition->{content}); } - + my $ctype = $transition->condition_type || die("No condition type"); if($ctype eq 'EXCEPTION') { if(my $dead = delete $deadline_map->{$transition->condition_expr}) { @@ -671,14 +671,14 @@ sub _set_elements { my $f = { formal_params => [ 'FormalParameters', 'FormalParameter' ] }; my $d = { data_fields => [ 'DataFields', 'DataField' ] }; my $s = { assignments => [ 'Assignments', 'Assignment' ] }; - + my $i = { input_sets => [ 'InputSets', 'InputSet' ] }; my $o = { output_sets => [ 'OutputSets', 'OutputSet' ] }; - my $r = { artifacts => [ 'Artifacts', 'Artifact' ] }; + my $r = { artifacts => [ 'Artifacts', 'Artifact' ] }; my $m = { data_maps => [ 'DataMappings', 'DataMapping' ] }; my $e = { extended_attr => [ 'ExtendedAttributes', 'ExtendedAttribute' ] }; - my $v = { event_attr => [ 'Event' ] }; + my $v = { event_attr => [ 'Event' ] }; my %types = ( Package => [$e, $d, $r], Application => [$f, $e], @@ -688,23 +688,23 @@ sub _set_elements { Transition => [$s], #Message(In|Out) => [], ); - my @pack = grep { ref($entry) =~ /^BPM::Engine::Store::Result::($_)$/ } + my @pack = grep { ref($entry) =~ /^BPM::Engine::Store::Result::($_)$/ } keys %types; die("Invalid regexp $entry ") unless scalar @pack == 1; my $container = $pack[0]; - + foreach my $type(@{ $types{$container} }) { my $field = (keys %{$type})[0]; my ($multi, $single) = @{ $type->{$field} }; my $json = ''; - #warn "Storing field $field multi $multi single $single type $type container $container entry $entry" + #warn "Storing field $field multi $multi single $single type $type container $container entry $entry" #if $container eq 'Package'; if(!$single && $multi eq 'Event') { $json = delete $args->{$multi}; my @event_types = keys %{$json}; next unless scalar @event_types; $json = scalar @event_types ? $json->{$event_types[0]} : {}; - + my $ev = $event_types[0] || 'EndEvent'; $ev =~ s/Event$//; $entry->event_type($ev); @@ -715,9 +715,9 @@ sub _set_elements { next unless $json->[0]; # get rid of XML::LibXML::Element objects from mixed-schema elements if($multi eq 'ExtendedAttributes' && ref($json->[0]) eq 'XML::LibXML::Element') { - $json = [map { - { Name => $_->getAttribute('Name') , - Value => $_->getAttribute('Value') } + $json = [map { + { Name => $_->getAttribute('Name') , + Value => $_->getAttribute('Value') } } @$json]; } elsif($container eq 'ActivityTask' && $multi eq 'ActualParameters') { @@ -738,7 +738,7 @@ sub _set_elements { }; if($@) { #use Data::Dumper; -#warn Dumper $json; +#warn Dumper $json; die "Error setting $field ($multi) as JSON: $@"; } } @@ -748,9 +748,9 @@ sub _set_elements { sub _hashxml { my $hash = shift; return unless(ref($hash) eq 'HASH'); - + foreach my $key(keys %{$hash}) { - $hash->{$key} = _serialize_schema($hash->{$key}) + $hash->{$key} = _serialize_schema($hash->{$key}) if($key eq 'DataType' && $hash->{$key}->{SchemaType}); $hash->{$key} = _checkxml($hash->{$key}); delete $hash->{$key} unless(defined $hash->{$key}); @@ -772,7 +772,7 @@ sub _checkxml { die("Invalid node type, not an XML::LibXML::Element"); } return unless $val->hasChildNodes(); - return { + return { content => $val->firstChild->textContent, map { $_->nodeName => $_->value } $val->attributes() }; @@ -788,12 +788,12 @@ sub _checkxml { sub _serialize_schema { my $val = shift; return unless $val; - + my $el = $val->{SchemaType}->{schema}->[0] or return; - die("Schema is not an 'XML::LibXML::Element'") + die("Schema is not an 'XML::LibXML::Element'") unless ref($el) eq 'XML::LibXML::Element'; $val->{SchemaType} = $el->toString; - + return $val; } @@ -819,7 +819,7 @@ BPM::Engine::Store::ResultSet::Package - Package DBIC resultset =head1 DESCRIPTION -This module extends L for the +This module extends L for the C table. =head1 METHODS @@ -828,13 +828,13 @@ C table. my $package = $rs->create_from_xpdl($input); -Takes xml input and returns a newly created Package row. Input can be a file, -URL, string or io stream; see C in +Takes xml input and returns a newly created Package row. Input can be a file, +URL, string or io stream; see C in L for details. =head1 EXCEPTIONS -If the XML is found to be inconsistent, C just dies with an +If the XML is found to be inconsistent, C just dies with an error message and nothing is inserted in the database. =head1 SEE ALSO diff --git a/lib/BPM/Engine/Util/Expression/Base.pm b/lib/BPM/Engine/Util/Expression/Base.pm index 4b1d6c7..98045d5 100644 --- a/lib/BPM/Engine/Util/Expression/Base.pm +++ b/lib/BPM/Engine/Util/Expression/Base.pm @@ -14,7 +14,7 @@ has 'params' => ( is => 'rw', default => sub { {} }, handles => { - get_param => 'get', + get_param => 'get', set_param => 'set', variables => 'keys', set_activity => [ set => 'activity' ], diff --git a/lib/BPM/Engine/Util/Expression/Xslate.pm b/lib/BPM/Engine/Util/Expression/Xslate.pm index a5fe09b..76b3a22 100644 --- a/lib/BPM/Engine/Util/Expression/Xslate.pm +++ b/lib/BPM/Engine/Util/Expression/Xslate.pm @@ -13,8 +13,8 @@ use BPM::Engine::Exceptions qw/throw_expression throw_abstract/; extends 'BPM::Engine::Util::Expression::Base'; my $_engine = Text::Xslate->new( - function => { - #attribute => sub { ... } + function => { + #attribute => sub { ... } }, module => ['Text::Xslate::Bridge::TT2Like'], # 'Text::Xslate::Bridge::Alloy', syntax => 'TTerse', @@ -27,10 +27,10 @@ my $_engine = Text::Xslate->new( sub _render { my ($self, $template, $args) = @_; - + $args ||= $self->params; $template = '[% ' . $template . ' %]' unless $template =~ /(\[%|%\])/; - + my $content; eval { # guard with timeout against infinite loops etc @@ -39,7 +39,7 @@ sub _render { $content = $_engine->render_string($template, $args); alarm 0; # restore }; - + if(my $err = $@) { throw_expression error => qq/Couldn't render template "$err"/; } @@ -53,9 +53,9 @@ sub evaluate { my $boolean = $self->_render($expr) || 0; - throw_expression("Condition eval '$expr': $boolean not a number") + throw_expression("Condition eval '$expr': $boolean not a number") unless $boolean =~ /^\d$/; - throw_expression("Condition eval '$expr': $boolean not boolean (0 or 1)") + throw_expression("Condition eval '$expr': $boolean not boolean (0 or 1)") unless ($boolean == 0 || $boolean == 1); return $boolean; @@ -63,7 +63,7 @@ sub evaluate { sub render { my ($self, $expr) = @_; - + my $args = $self->params; my $output_buffer = ''; $args->{output} = sub { $output_buffer = $_[0]; }; @@ -81,14 +81,14 @@ sub assign { if(ref($expr)) { $expr = $expr->{content}; } my $output = $self->render($expr); - + my $pi = $self->process_instance; my ($root, @junk) = split(/\./, $trg); if(scalar @junk) { my $stash = Template::Stash->new(); my $attrib = $pi->attribute($root)->value; - $stash->set($root, $attrib); - eval{ + $stash->set($root, $attrib); + eval{ # set rvalue output as lvalue val, merging with $root $stash->set($trg, $output); }; @@ -100,7 +100,7 @@ sub assign { else { $pi->attribute($root => $output); } - + } sub dotop { diff --git a/lib/BPM/Engine/Util/ExpressionEvaluator.pm b/lib/BPM/Engine/Util/ExpressionEvaluator.pm index 6684e91..abd026c 100644 --- a/lib/BPM/Engine/Util/ExpressionEvaluator.pm +++ b/lib/BPM/Engine/Util/ExpressionEvaluator.pm @@ -12,25 +12,25 @@ use BPM::Engine::Exceptions qw/throw_param/; sub load { my ($class, %args) = @_; - - my $pi = $args{process_instance} + + my $pi = $args{process_instance} or throw_param error => 'Need a process instance'; my $params = { arguments => delete $args{arguments} || [], var => BPM::Engine::ExprVar->new(pi => $pi), attribute => sub { - my $name = shift or #die("Need an attribute name"); + my $name = shift or #die("Need an attribute name"); return BPM::Engine::ExprVar->new(pi => $pi); my $attr = $pi->attribute($name); - return $attr->value; + return $attr->value; }, }; - + foreach my $param(qw/ process process_instance activity activity_instance transition /) { next unless($args{$param}); - throw_param error => "Not an object: $param" + throw_param error => "Not an object: $param" unless(blessed $args{$param}); #eval { $args{$param} = sub { $args{$param}->TO_JSON; } }; eval { $params->{$param} = delete($args{$param})->TO_JSON; }; @@ -43,8 +43,8 @@ sub load { if keys %args; return BPM::Engine::Util::Expression::Xslate->new( - process_instance => $pi, - params => $params + process_instance => $pi, + params => $params ); } @@ -66,7 +66,7 @@ sub new { sub AUTOLOAD { my $self = shift; (my $method = $AUTOLOAD) =~ s/.*:://; - return if $method eq 'DESTROY'; + return if $method eq 'DESTROY'; my $pi = $self->{pi}; my $attr = $pi->attribute($method); return $attr->value; @@ -86,20 +86,20 @@ BPM::Engine::Util::ExpressionEvaluator - Inference engine loader =head1 SYNOPSIS use BPM::Engine::Util::ExpressionEvaluator; - + my $evaluator = BPM::Engine::Util::ExpressionEvaluator->load( - process_instance => $pi, + process_instance => $pi, process => $pi->process, activity => $activity_instance->activity, activity_instance => $activity_instance, transition => $transition ); - + $evaluator->render() =head1 DESCRIPTION -This module loads an instance of +This module loads an instance of L suitable for evaluating XPDL expressions. @@ -107,11 +107,11 @@ suitable for evaluating XPDL expressions. =head2 load -Accepts a hash of options, and returns a new +Accepts a hash of options, and returns a new L -instance suitable for rendering and evaluating XPDL expressions. In addition -to providing the supplied options in the template strings as simple hash -references, the expression evaluator will be supplied with an C +instance suitable for rendering and evaluating XPDL expressions. In addition +to providing the supplied options in the template strings as simple hash +references, the expression evaluator will be supplied with an C function to make use of process instance variables in expressions. Possible options are: @@ -120,17 +120,17 @@ Possible options are: =item C -L -instance whose attributes will be rendered or evaluated. This is the only +L +instance whose attributes will be rendered or evaluated. This is the only required option. =item C -A L +A L result row. =item C - + A L result row. @@ -147,8 +147,8 @@ result row. =back The L -instance that is returned contains all options which are available to template -strings as simple hash references. In addition, the C result +instance that is returned contains all options which are available to template +strings as simple hash references. In addition, the C result row is used as a constructor argument. =head1 AUTHOR diff --git a/lib/BPM/Engine/Util/XPDL.pm b/lib/BPM/Engine/Util/XPDL.pm index 8c5e383..d852f69 100644 --- a/lib/BPM/Engine/Util/XPDL.pm +++ b/lib/BPM/Engine/Util/XPDL.pm @@ -58,7 +58,7 @@ sub xml_doc { sub xml_hash { my $arg = shift or throw_param error => "Empty file, string or IO handle (xml_hash)"; - + my $xmldata = XML::LibXML::Simple::XMLin($arg, ForceArray => [qw/ ExtendedAttribute FormalParameter DataField ActualParameter Participant Application Responsible @@ -67,7 +67,7 @@ sub xml_hash { NormaliseSpace => 2, ValueAttr => [ 'GraphConformance' ], ); - + return $xmldata; } @@ -83,7 +83,7 @@ sub xpdl_doc { my $v = $nodes[0]->textContent; $v =~ s/(^\s*|\s*$)//g; die "XPDL version not set" unless $v; - die "Unsupported XPDL version $v" + die "Unsupported XPDL version $v" unless(grep { $v == $_ } qw/1.0 2.0 2.1 2.2/); $v =~ s/\./_/; @@ -98,7 +98,7 @@ sub xpdl_doc { my $schema = XML::LibXML::Schema->new(location => $schema_file); eval { $schema->validate($doc); }; - + if(my $err = $@) { if(ref($err) eq 'XML::LibXML::Error') { die "Non-conformant XML: " . $err->message . @@ -112,7 +112,7 @@ sub xpdl_doc { } } }; - + if(my $err = $@) { $err->rethrow() if(is_Exception($err)); throw_model error => $err; @@ -168,7 +168,7 @@ sub _remove_attributes { my @nodes = $xmldoc->getElementsByTagName($tag); foreach my $node(@nodes) { - foreach(@attr) { + foreach(@attr) { $node->removeAttribute($_); } } @@ -197,7 +197,7 @@ sub _xpdl_spec { my $file; eval { - # suppress warnings from File::ShareDir feeding uninitialized dir to + # suppress warnings from File::ShareDir feeding uninitialized dir to # File::Spec's catfile() when dist not installed. # no warnings 'uninitialized' doesn't work here. local $SIG{__WARN__} = sub {}; @@ -213,14 +213,14 @@ sub _xpdl_spec { throw_install error => "Schema '$fname' not found in shared dirs"; } unless ( -r $file) { - throw_install + throw_install error => "Schema '$fname' cannot be read, no read permissions"; } } elsif($@) { throw_install error => "Schema '$fname' not found in shared dirs: $@"; } - + return $file; } @@ -240,7 +240,7 @@ BPM::Engine::Util::XPDL - XPDL parsing helper functions =head1 SYNOPSIS use BPM::Engine::Util::XPDL ':all'; - + $data = xpdl_hash($input); say $data->{WorkflowProcesses}->[0]->{Id}; @@ -251,7 +251,7 @@ This module provides helper functions for parsing of XPDL files and strings. =head2 Parameter INPUT -The first parameter to any function should be the XML message to be translated +The first parameter to any function should be the XML message to be translated into a Perl structure. Choose one of the following: =over 4 @@ -268,7 +268,7 @@ Note, the filename C<< - >> (dash) can be used to parse from STDIN. =item A scalar reference to an XML string A string containing XML will be parsed directly. - + my $string = 'Thing'; $doc = xml_doc(\$string); @@ -283,7 +283,7 @@ An IO::Handle object will be read to EOF and its contents parsed. eg: =head1 EXPORTS -None of the functions are exported by default. The C<:all> key exports all +None of the functions are exported by default. The C<:all> key exports all functions. =head2 xpdl_hash @@ -321,7 +321,7 @@ A 'lightweight' parsing of XPDL-like XML strings. Useful for testing. Example: !; my $data = xml_hash($string); - + say $data->{WorkflowProcesses}->[0]->{Id}; # prints 'OrderPizza' This function will possibly be deprecated in the near future. @@ -335,8 +335,8 @@ Parses the given file (or URL), string, or input stream into a DOM tree. Returns a L object. =head2 xpdl_doc - -Parses the given file (or URL), string, or input stream (by calling + +Parses the given file (or URL), string, or input stream (by calling C) and does some checks on the document, specifically: =over 4 diff --git a/lib/BPM/Engine/Util/YAMLWorkflowLoader.pm b/lib/BPM/Engine/Util/YAMLWorkflowLoader.pm index 7df8cf7..06fcf38 100644 --- a/lib/BPM/Engine/Util/YAMLWorkflowLoader.pm +++ b/lib/BPM/Engine/Util/YAMLWorkflowLoader.pm @@ -28,7 +28,7 @@ __PACKAGE__->meta->make_immutable; ## no critic (ProhibitMultiplePackages) { -package +package BPM::Engine::Class::Workflow::State; use namespace::autoclean; diff --git a/t/02-store/12-transition.t b/t/02-store/12-transition.t index 8c11740..8a300dc 100644 --- a/t/02-store/12-transition.t +++ b/t/02-store/12-transition.t @@ -143,6 +143,6 @@ my $aiD = eval { $tBD->apply($aiB); }; $aiD = eval { $tCD->apply($aiC); }; ok($aiD); -ok(!$aiD->is_enabled); +ok(!$aiD->is_enabled); done_testing(); diff --git a/t/04-run/01-transition.t b/t/04-run/01-transition.t index 23b0b1f..ab3c6b3 100644 --- a/t/04-run/01-transition.t +++ b/t/04-run/01-transition.t @@ -22,8 +22,8 @@ if(1) { my $activity = $p->start_activities->[0]; my $ai_A = #$r->_create_activity_instance($activity); - $activity->new_instance({ - process_instance_id => $i->id + $activity->new_instance({ + process_instance_id => $i->id }); # main path (before splitted or after joined) doesn't have a parent_token # OR any ai not directly after a split doesn't have a parent_token, use ->prev instead ?? @@ -34,7 +34,7 @@ if(1) { #- follow transition A-B1 (split->join) #----------------------------------------- - ok(my $t_A_B1 = $activity->transitions->find({ transition_uid => 'ex4.A-B1'})); + ok(my $t_A_B1 = $activity->transitions->find({ transition_uid => 'ex4.A-B1'})); ok(my $a_B1 = $t_A_B1->to_activity); ok(my $t_A_B = $activity->transitions->find({ transition_uid => 'ex4.A-B'})); @@ -58,7 +58,7 @@ if(1) { my $ai_B1 = $t_A_B1->derive_and_accept_instance($ai_A, $attrs, @args); 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 + # 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 @@ -99,7 +99,7 @@ if(1) { my $ai_B = $t_A_B->derive_and_accept_instance($ai_A, $attrs, @args); is($ai_B->activity->activity_uid, 'ex4.B','derive_and_accept results in B'); - # transition in joinA set to 'taken' since we're coming from a split + # transition in joinA set to 'taken' since we're coming from a split $ai_A->split->discard_changes(); is($ai_A->split->states->{$t_A_B->id}, 'taken', "Transition A-B state is 'taken'"); is($ai_A->split->states->{$t_A_B1->id}, 'taken', "Transition A-B1 state is 'taken'"); @@ -134,7 +134,7 @@ if(1) { #is($ai_B->split->states->{$t_B_B1->id}, 'joined'); ok($ai_B->is_completed); #ok($ai_B1->is_completed); - ok($ai_B1b->is_active); + ok($ai_B1b->is_active); # C-JOIN @@ -152,7 +152,7 @@ if(1) { $attrs = { activity => $a_C }; my $ai_C = $t_B_C->derive_and_accept_instance($ai_B, $attrs, @args); - is($ai_C->activity->activity_uid, 'ex4.C','derive_and_accept results in C'); + is($ai_C->activity->activity_uid, 'ex4.C','derive_and_accept results in C'); ok(!$ai_C->is_enabled(), 'Join C should not fire yet'); $ai_C->update({ deferred => DateTime->now() }); @@ -180,14 +180,14 @@ if(1) { # join D should not fire, path C-D hasn't come in yet #ok(!$a_D->should_join_fire($t_B2_D, $ai_B2), 'Join should not fire from B2'); - + $ai_B2->update({ completed => DateTime->now() }); my $ai_D = $t_B2_D->derive_and_accept_instance($ai_B2, $attrs, @args); is($ai_D->activity->activity_uid, 'ex4.D','derive_and_accept results in D'); ok(!$ai_D->is_enabled(), 'Join D should not fire yet'); $ai_D->update({ deferred => DateTime->now() }); - + #- follow transition C-D (join->join) #----------------------------------------- $attrs = { activity => $a_D, }; @@ -225,8 +225,8 @@ if(000) { my $aD = $p->activities->find({ activity_uid => 'D' }); #my $activity = $p->start_activities->[0]; - my $ai_A = $aA->new_instance({ - process_instance_id => $i->id + my $ai_A = $aA->new_instance({ + process_instance_id => $i->id }); my $ai_B = $tAB->derive_and_accept_instance($ai_A, { activity => $aB }, @args); @@ -242,7 +242,7 @@ if(000) { my $ai_D2 = $tCD->derive_and_accept_instance($ai_C, { activity => $aD }, @args); is($ai_D2->activity->activity_uid, 'D','derive_and_accept results in D'); -} +} if(1) { my ($r,$p,$i) = runner($engine, 'multi-inclusive-split-and-join', { splitA => 'B1', splitB => undef }); @@ -261,8 +261,8 @@ if(1) { my $aC = $p->activities->find({ activity_uid => 'ex1.C' }); my $aD = $p->activities->find({ activity_uid => 'ex1.D' }); - my $ai_A = $aA->new_instance({ - process_instance_id => $i->id + my $ai_A = $aA->new_instance({ + process_instance_id => $i->id }); #ok(!$ai_A->split->should_fire($tAB, 1)); # dies with transition not taken @@ -324,7 +324,7 @@ if(1) { # ok($ai_C->is_reachable_from($aA)); # ok($ai_C->is_reachable_from($aB)); -# ok(!$ai_C->is_reachable_from($aB1)); +# ok(!$ai_C->is_reachable_from($aB1)); # ok(!$ai_C->is_reachable_from($aD)); ok(!$ai_B->split->should_fire($tBB1, 1)); @@ -339,7 +339,7 @@ if(1) { $ai_A->split->discard_changes; # ok($ai_A->split->should_fire($tAB1, 1)); # ok($ai_A->split->should_fire($tAB, 1)); - + # B1-D $ai_B1b->update({ completed => DateTime->now() }); @@ -373,8 +373,8 @@ if(1) { #-- follow all transitions if(1) { - my $ai_A = $aA->new_instance({ - process_instance_id => $i->id + my $ai_A = $aA->new_instance({ + process_instance_id => $i->id }); # A-B @@ -397,7 +397,7 @@ if(1) { ok(!$ai_B1a->is_enabled(), 'Join B1 should not fire'); $ai_B1a->update({ deferred => DateTime->now }); - + # trans A-B1 set to 'taken' $ai_A->split->discard_changes; #is($ai_A->split->states->{$tAB1->id}, 'joined'); @@ -436,7 +436,7 @@ if(1) { $ai_B1b->update({ completed => DateTime->now() }); my $ai_B2 = $tB1B2->derive_and_accept_instance($ai_B1b, { activity => $aB2 }, @args); 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); @@ -464,8 +464,8 @@ if(1) { #-- follow some transitions else { - my $ai_A = $aA->new_instance({ - process_instance_id => $i->id + my $ai_A = $aA->new_instance({ + process_instance_id => $i->id }); # A-B @@ -491,7 +491,7 @@ if(1) { # WCP10: Arbitrary Cycles (nested-loops) - test tokensets if(1) { $engine->create_package('./t/var/06-iteration.xpdl'); - + my ($r,$p,$i) = runner($engine, 'wcp10b2', { inner_loop => '1', outer_loop => 1 }); my @args = (); @@ -538,7 +538,7 @@ if(1) { my $ai_A2 = $tDA->derive_and_accept_instance($ai_D, { activity => $aA }, @args); ok($ai_A2->is_enabled(), 'Join1 should fire'); - # B and C have active instances + # B and C have active instances my $rs = $engine->schema->resultset('ActivityInstance'); is($rs->active({ process_instance_id => $i->id })->count, 2); is($i->activity_instances->active->count, 2); diff --git a/t/04-run/11-routes.t b/t/04-run/11-routes.t index 6a7452a..f087fa8 100644 --- a/t/04-run/11-routes.t +++ b/t/04-run/11-routes.t @@ -27,7 +27,7 @@ ok(my $engine = BPM::Engine->new( #warn "$event $entity $act"; return 1 unless($entity eq 'activity' && $event eq 'execute'); - + #isa_ok($node, 'BPM::Engine::Store::Result::ActivityTask'); #isa_ok($instance, 'BPM::Engine::Store::Result::ActivityInstance'); diff --git a/t/TestUtils.pm b/t/TestUtils.pm index 5412890..9f94add 100644 --- a/t/TestUtils.pm +++ b/t/TestUtils.pm @@ -12,7 +12,7 @@ use parent qw/Exporter/; our @EXPORT = qw/ $dsn schema process_wrap runner /; my ($_schema, $_attr); -our ($dsn, $user, $password, $DEBUG) = +our ($dsn, $user, $password, $DEBUG) = @ENV{map { "BPMTEST_${_}" } qw/DSN USER PASS KEEP/}; if($dsn && $user && !$DEBUG) { @@ -23,7 +23,7 @@ else { 'dbi:SQLite:dbname=t/var/bpmengine.db' : 'dbi:SQLite::memory:'; $user = ''; $password = ''; - $_attr = { sqlite_unicode => 1 }; + $_attr = { sqlite_unicode => 1 }; } sub _local_db { @@ -41,14 +41,14 @@ sub _local_db { sub schema { unless($_schema) { _local_db() if $DEBUG; - eval "require BPM::Engine::Store" + eval "require BPM::Engine::Store" or die "failed to require schema: $@"; - $_schema = BPM::Engine::Store->connect($dsn, $user, $password, $_attr) + $_schema = BPM::Engine::Store->connect($dsn, $user, $password, $_attr) or die "failed to connect to $dsn"; - $_schema->deploy({ add_drop_table => $_attr->{sqlite_unicode} ? 0 : 1 }) + $_schema->deploy({ add_drop_table => $_attr->{sqlite_unicode} ? 0 : 1 }) unless $DEBUG; } - + return $_schema; } @@ -102,20 +102,20 @@ t::TestUtils - Test utitily functions for BPM::Engine =head1 SYNOPSIS use t::TestUtils; - - is($dsn, 'dbi:SQLite::memory:'); - + + is($dsn, 'dbi:SQLite::memory:'); + isa_ok(schema(), 'BPM::Engine::Store'); schema()->resultset('Blah')->create({ blah => '123' }); - + my ($engine, $process) = process_wrap($process_xml, $package_xml); - + my ($runner, $process, $instance) = runner($engine, $process_uid, \%args); my ($runner, $process, $instance) = runner( process_wrap($xml) ); =head1 DESCRIPTION -Test utility functions for L tests. See the F<*.t> +Test utility functions for L tests. See the F<*.t> files for usage examples. =head1 EXPORTED VARIABLE AND FUNCTIONS @@ -126,14 +126,14 @@ The dsn of the test database used. =head2 schema -Creates a temporary SQLite database, deploys the -L schema, and then connects to it. -Subsequent calls to C will return the schema created on the first -call. Since you have a fresh database for every test, you don't have to worry +Creates a temporary SQLite database, deploys the +L schema, and then connects to it. +Subsequent calls to C will return the schema created on the first +call. Since you have a fresh database for every test, you don't have to worry about cleaning up after your tests, ordering of tests affecting failure, etc. Returns the L instance connected and -deployed to the test database. When your program exits, the temporary in-memory +deployed to the test database. When your program exits, the temporary in-memory database will go away, unless BPMTEST_KEEP is set. =head2 process_wrap @@ -147,23 +147,23 @@ engine and the process result row. =item $process_xml -Optional xml string representing any XPDL child elements in the +Optional xml string representing any XPDL child elements in the C after the C element =item $package_xml -Optional xml string representing any XPDL child elements coming after the +Optional xml string representing any XPDL child elements coming after the C element in the C definition =back =head2 runner -Takes a L object, a process_uid or a -L +Takes a L object, a process_uid or a +L object and an optional hashref of processs instance arguments, and creates a -ProcessInstance result row. Returns a -L instance for the +ProcessInstance result row. Returns a +L instance for the process instance, the Process result row and the ProcessInstance result row. =head1 ENVIRONMENT @@ -176,20 +176,20 @@ environment variables. =head2 BPMTEST_KEEP -If this variable is true, then the test database will not be deleted at C +If this variable is true, then the test database will not be deleted at C time. Instead, the database will be available as F<./t/var/bpmengine.db>. -This is useful if you want to look at the database your test generated, for +This is useful if you want to look at the database your test generated, for debugging. Note that the database will never exist on disk if you don't set this to a true value. =head2 BPMTEST_DSN -If this variable is specified, this dsn will be connected to instead of the -in-memory or temporary SQLite database. This will only be used if BPMTEST_KEEP +If this variable is specified, this dsn will be connected to instead of the +in-memory or temporary SQLite database. This will only be used if BPMTEST_KEEP is false, and at least the BPMTEST_USER is specified as well. -WARNING: This will drop all tables used on test deployment, and all data will be +WARNING: This will drop all tables used on test deployment, and all data will be lost. You do NOT ever want to set this to the production database's dsn. =head2 BPMTEST_USER diff --git a/t/var/gen_xpdl.pl b/t/var/gen_xpdl.pl index 6a516f7..7bee622 100644 --- a/t/var/gen_xpdl.pl +++ b/t/var/gen_xpdl.pl @@ -50,7 +50,7 @@ items => [qw//], }, ]; - + foreach my $pack(@$t) { next unless @{$pack->{items}}; @@ -73,7 +73,7 @@ 17-production 18-production-unsynchronized /; - + $tt->process( './t/var/samples/package.tt', { id => 'samples', title => 'Samples', items => \@t, }, diff --git a/t/var/patterns/_wcp09 b/t/var/patterns/_wcp09 index c5f285a..4ca8f45 100644 --- a/t/var/patterns/_wcp09 +++ b/t/var/patterns/_wcp09 @@ -1,2 +1,2 @@ IncomingCondition -COMPLEX-Join +COMPLEX-Join diff --git a/t/var/patterns/wcp10b b/t/var/patterns/wcp10b index ba49584..e511c8b 100644 --- a/t/var/patterns/wcp10b +++ b/t/var/patterns/wcp10b @@ -157,13 +157,13 @@ - attribute('inner_loop') > 0 + attribute('inner_loop') > 0 1 - attribute('outer_loop') > 0 + attribute('outer_loop') > 0 diff --git a/t/var/patterns/wcp37 b/t/var/patterns/wcp37 index 0db24db..fdf378e 100644 --- a/t/var/patterns/wcp37 +++ b/t/var/patterns/wcp37 @@ -89,19 +89,19 @@ - attribute('multi_choice').search('B') + attribute('multi_choice').search('B') - attribute('multi_choice').search('C') + attribute('multi_choice').search('C') - attribute('deferred_choice').search('D') + attribute('deferred_choice').search('D') - + diff --git a/t/var/patterns/wcp38 b/t/var/patterns/wcp38 index ed9b90c..65621fc 100644 --- a/t/var/patterns/wcp38 +++ b/t/var/patterns/wcp38 @@ -100,20 +100,20 @@ - attribute('multi_choice').search('B') + attribute('multi_choice').search('B') - attribute('multi_choice').search('XOR') + attribute('multi_choice').search('XOR') - attribute('deferred_choice').search('D') + attribute('deferred_choice').search('D') - attribute('deferred_choice').search('E') + attribute('deferred_choice').search('E') diff --git a/t/var/patterns/wcp41 b/t/var/patterns/wcp41 index a74e48b..0b581b3 100644 --- a/t/var/patterns/wcp41 +++ b/t/var/patterns/wcp41 @@ -25,6 +25,6 @@ - + diff --git a/t/var/samples/06-multi-or-split-and-join b/t/var/samples/06-multi-or-split-and-join index c768c4c..4025e32 100644 --- a/t/var/samples/06-multi-or-split-and-join +++ b/t/var/samples/06-multi-or-split-and-join @@ -31,7 +31,7 @@ 'Mona Lisa' - + @@ -85,7 +85,7 @@ 1 - + 1 diff --git a/t/var/samples/07-multi-and-split-and-join b/t/var/samples/07-multi-and-split-and-join index d832dc2..4d7ee03 100644 --- a/t/var/samples/07-multi-and-split-and-join +++ b/t/var/samples/07-multi-and-split-and-join @@ -31,7 +31,7 @@ 'Mona Lisa' - + @@ -85,7 +85,7 @@ 1 - + 1 diff --git a/t/var/samples/14-inclusive-splits-and-joins b/t/var/samples/14-inclusive-splits-and-joins index 8c36313..f9e505e 100644 --- a/t/var/samples/14-inclusive-splits-and-joins +++ b/t/var/samples/14-inclusive-splits-and-joins @@ -33,7 +33,7 @@ 'D' - + diff --git a/t/var/samples/17-production b/t/var/samples/17-production index 8f81838..a4de981 100644 --- a/t/var/samples/17-production +++ b/t/var/samples/17-production @@ -42,7 +42,7 @@ - + diff --git a/t/var/samples/18-production-unsynchronized b/t/var/samples/18-production-unsynchronized index 3324a6f..a3e0166 100644 --- a/t/var/samples/18-production-unsynchronized +++ b/t/var/samples/18-production-unsynchronized @@ -42,7 +42,7 @@ - + diff --git a/t/var/tasks/tasks b/t/var/tasks/tasks index 0f11124..af09280 100644 --- a/t/var/tasks/tasks +++ b/t/var/tasks/tasks @@ -56,7 +56,7 @@ - + @@ -96,8 +96,8 @@ - - + + @@ -106,11 +106,11 @@ - - - ParProcFieldName - 'This subprocess has not been invoked' - + + + ParProcFieldName + 'This subprocess has not been invoked' + @@ -126,18 +126,18 @@ - - - ParProcFieldName - 'This subprocess has not been invoked' - + + + ParProcFieldName + 'This subprocess has not been invoked' + - - + + @@ -177,7 +177,7 @@ - + @@ -192,8 +192,8 @@ - - + + - - + +