Workflow::Wfmc - A lightweight Workflow Engine in PERL based on XPDL 2.0
Index
Code Index:
NAME
Workflow::Wfmc - A lightweight Workflow Engine in PERL based on XPDL 2.0
SYNOPSIS
DESCRIPTION
This is an partial implementation of XML Process Definition Language (XPDL) Version 2 (see Web page of Workflow Management Coalition - http://www.wfmc.org). It supports input and output parameters for a workflow, routing, call-back functions and conditions. It does not support sub-processes and exceptions at the moment. You can run 'perl t/Workflow-Wfmc.t -t "PO"' or 'perl t/Workflow-Wfmc.t -t "Credit"' to see how it works. The workflow configuration file "workflow.xml" can be created with some visual tools (e.g., SAP Workflow Editor). The sample package "Workflow::Wfmc::Test::Order" contains dummy call-back functions. As a matter of fact, the executable program itself could be generated from the workflow configuration file, which is something that the author would like to complete in a successive release. To test it, you should prepare your workflow configuration file and the packages that contain call-back functions first and then generate an executable program following the example of t/Workflow-Wfmc.t.
EXPORT
AUTHOR
COPYRIGHT AND LICENSE
Copyright (C) 2005 by Kai Li
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.
package Workflow::Wfmc;
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use XML::Simple qw(XMLin XMLout);
require Exporter;
use AutoLoader qw(AUTOLOAD);
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Workflow::Wfmc ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.01e';
my $PACKAGE = __PACKAGE__;
our @LOGOPT;
my %LOGFLAG = (
'emerg' => 0,
'crit' => 0,
'error' => 0,
'warn' => 0,
'notice' => 0,
'info' => 0,
'debug' => 0,
); # apache logging levels
my $INITIALIZED = 0;
my $CONFIG;
my $MYSELF;
# Preloaded methods go here.
# Autoload methods go after =cut, and are processed by the autosplit program.
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {};
if (defined $_[0] && defined $_[1] && shift eq 'Id') {
$self->{Id} = shift;
$self->{DataFields} = undef; # DataFields are variables used in workflow
$self->{FormalParameters} = undef; # FormalParameters are variables used in workflow
}
else
{
die "(die): Lack of Id in subroutine new of $PACKAGE"
}
$MYSELF = $self;
bless ($self,$class);
return $self;
}
#sub DESTROY
#{
# my $invocant = shift;
# print STDERR "(debug): Destroying object of $PACKAGE\n";
# print STDERR "(debug): Argh. Life was sweet.\n";
#}
sub Id
{
my $invocant = shift;
$invocant->logger->debug("Entering subroutine Id of $PACKAGE");
$invocant->logger->debug("Leaving subroutine Id of $PACKAGE");
(@_) ? return shift : return $invocant->{Id};
}
sub workflow {
my $invocant = shift;
my ($wfps,$wfp_id) = (shift,shift);
my $wfp = $wfps->{'WorkflowProcess'}->[$wfp_id-1];
my $wfp_pheader = $wfp->{'ProcessHeader'};
my $wfp_fparam = $wfp->{'FormalParameters'};
my $wfp_dataf = $wfp->{'DataFields'};
my $wfp_part = $wfp->{'Partitions'};
my $wfp_app = $wfp->{'Applications'};
my $wfp_act = $wfp->{'Activities'};
my $wfp_trans = $wfp->{'Transitions'};
#print Dumper($wfp_trans);
return $invocant;
}
sub debug
{
my $invocant = shift;
return $invocant unless($LOGFLAG{'debug'});
if(@_)
{
my @lines = split("\n",shift);
my $n = 0;
my $length = $#lines + 1;
foreach my $line (@lines)
{
$n++;
print STDERR "(debug)\t($n/$length):\t$line\n" ;
}
}
else
{
print STDERR "(debug)\t(1/1):\tLack of content in subroutine debug of $PACKAGE";
}
return $invocant;
}
;
sub warn
{
my $invocant = shift;
return $invocant unless($LOGFLAG{'warn'});
if(@_)
{
my @lines = split("\n",shift);
my $n = 0;
my $length = $#lines + 1;
foreach my $line (@lines)
{
$n++;
print STDERR "(warn)\t($n/$length):\t$line\n" ;
}
}
else
{
print STDERR "(warn)\t(1/1):\tLack of content in subroutine warn of $PACKAGE";
}
return $invocant;
}
;
sub error
{
my $invocant = shift;
#return $invocant unless($LOGFLAG{'error'});
if(@_)
{
my @lines = split("\n",shift);
my $n = 0;
my $length = $#lines + 1;
foreach my $line (@lines)
{
$n++;
print STDERR "(error)\t($n/$length):\t$line\n" ;
}
if(my $vie = $invocant->error_notify_via)
{
if ($vie =~ /\bemail\b/)
{
my $body = join('',@lines);
my $subject = 'STM error message';
$invocant->sendmail($subject,$body);
}
if ($vie =~ /\bjabber\b/)
{
my $body = join('',@lines);
my $subject = 'STM error message';
$invocant->sendjabber($subject,$body);
}
}
}
else
{
print STDERR "(error)\t(1/1):\tLack of content in subroutine error of $PACKAGE";
}
return $invocant;
}
;
sub info
{
my $invocant = shift;
return $invocant unless($LOGFLAG{'info'});
if(@_)
{
my @lines = split("\n",shift);
my $n = 0;
my $length = $#lines + 1;
foreach my $line (@lines)
{
$n++;
print STDERR "(info)\t($n/$length):\t$line\n" ;
}
}
else
{
print STDERR "(info)\t(1/1):\tLack of content in subroutine info of $PACKAGE";
}
return $invocant;
}
sub notice
{
my $invocant = shift;
return $invocant unless($LOGFLAG{'notice'});
if(@_)
{
my @lines = split("\n",shift);
my $n = 0;
my $length = $#lines + 1;
foreach my $line (@lines)
{
$n++;
print STDERR "(notice)\t($n/$length):\t$line\n" ;
}
}
else
{
print STDERR "(notice)\t(1/1):\tLack of content in subroutine notice of $PACKAGE";
}
return $invocant;
}
sub emerg
{
my $invocant = shift;
return $invocant unless($LOGFLAG{'emerg'});
if(@_)
{
my @lines = split("\n",shift);
my $n = 0;
my $length = $#lines + 1;
foreach my $line (@lines)
{
$n++;
print STDERR "(emerg)\t($n/$length):\t$line\n" ;
}
}
else
{
print STDERR "(emerg)\t(1/1):\tLack of content in subroutine emerg of $PACKAGE";
}
return $invocant;
}
sub crit
{
my $invocant = shift;
return $invocant unless($LOGFLAG{'crit'});
if(@_)
{
my @lines = split("\n",shift);
my $n = 0;
my $length = $#lines + 1;
foreach my $line (@lines)
{
$n++;
print STDERR "(crit)\t($n/$length):\t$line\n" ;
}
}
else
{
print STDERR "(crit)\t(1/1):\tLack of content in subroutine crit of $PACKAGE";
}
return $invocant;
}
sub logger # also a initializer ;-)
{
my $invocant = shift;
unless($INITIALIZED)
{
foreach my $n (@LOGOPT)
{
$LOGFLAG{$n} = 1;
}
$INITIALIZED = 1;
}
return $invocant;
}
sub load_conf
{
use XML::XPath;
my $invocant = shift;
$invocant->logger->debug("Entering subroutine load_conf of $PACKAGE");
my ($file,$nodeset);
if(@_)
{
$file = shift;
die "(die): Configuration file $file does not exit or empty of $PACKAGE" unless( -s $file);
$invocant->logger->debug("Config file name $file passed");
$CONFIG = XML::XPath->new(filename => $file );
$invocant->logger->debug("XML::XPath object created");
$nodeset = $CONFIG->find('/'); # find all paragraphs
$invocant->logger->debug("Finding config root node");
foreach my $node ($nodeset->get_nodelist)
{
$invocant->logger->debug(XML::XPath::XMLParser::as_string($node));
}
$invocant->logger->debug("Config file $file loaded");
}
else
{
die "(die): Lack of copnfiguration file name in subroutine load_conf of $PACKAGE";
}
$invocant->logger->debug("Leaving subroutine load_conf of $PACKAGE");
return $CONFIG;
}
sub init_data_fields # intialize DataFields (with values if possible) using the workflow configuration file
{
my ($invocant,$wfp_id) = (shift,shift);
$invocant->logger->debug("Entering subroutine init_data_fields of $PACKAGE");
my $xml = $invocant->get_wfp_element($wfp_id,'DataFields');
my $perl = XMLin($xml);
my $df = $perl->{'DataField'};
my @df;
my $datafields;
eval{@df = @$df;};
push @df, $df if($@);
foreach(@df){
if(defined $_->{'InitialValue'}){
$invocant->{DataFields}->{$_->{'Id'}} = $_->{'InitialValue'};
}else{
$invocant->{DataFields}->{$_->{'Id'}} = '';
}
}
$invocant->logger->debug("Leaving subroutine init_data_fields of $PACKAGE");
return $invocant->{DataFields};
}
sub data_fields # set elements in DataFields and retrun a pointer to the DataFields
{
my ($invocant,$df) = (shift,shift);
$invocant->logger->debug("Entering subroutine data_fields of $PACKAGE");
if(defined $df){
my %df = %$df;
my @chiave = keys(%df);
foreach(@chiave){
$invocant->{DataFields}->{$_} = $df->{$_};
}
}
$invocant->logger->debug("Leaving subroutine data_fields of $PACKAGE");
return $invocant->{DataFields};
}
# This method generates PERL code to call some library (PERL class). Produces something like
# use Kai::Order::Simple;
# Kai::Order::Simple::checkData('orderInfo'=>'Blah',);
sub get_perl_by_method{ # only accept strings as import data
my ($invocant,$cls,$mtd,$param) = @_;
#print $_,"\n" foreach(@param);exit;
$invocant->logger->debug("Entering subroutine parser of $PACKAGE");
my $perl = "use $cls\;\n";
if(defined $mtd){
$perl .= $cls.'::';
$perl .= $mtd.'({';
}
foreach(@$param){
$perl .= $_;
$perl .= q{,};
}
$perl .= "})\;\n";
$invocant->logger->debug("Leaving subroutine get_perl_by_method of $PACKAGE");
$perl;
}
sub get_activity_by_id{ # Return the Activity (identified by activity ID) subnode of the workflow configuration file
my ($invocant,$wfp_id,$act_id) = @_;
$invocant->logger->debug("Entering subroutine get_activity_by_id of $PACKAGE");
my $nodeset = $CONFIG->find(q|/Package/WorkflowProcesses/WorkflowProcess[@Id='|.$wfp_id.q|']/Activities/Activity[@Id='|.$act_id.q|']|); # find all paragraphs
foreach my $node ($nodeset->get_nodelist)
{
$invocant->logger->debug("Leaving subroutine get_activity_by_id of $PACKAGE");
return XML::XPath::XMLParser::as_string($node);
}
}
sub get_dest_act_id{ # Return the Transaction (identified by 'From') subnodes of the workflow configuration file
my ($invocant,$wfp_id,$act_id) = @_;
$invocant->logger->debug("Entering subroutine get_activity_by_id of $PACKAGE");
my $nodeset = $CONFIG->find(q|/Package/WorkflowProcesses/WorkflowProcess[@Id='|.$wfp_id.q|']/Transitions/Transition[@From='|.$act_id.q|']|); # find all paragraphs
my @res;
foreach my $node ($nodeset->get_nodelist)
{
push @res, XML::XPath::XMLParser::as_string($node);
}
$invocant->logger->debug("Leaving subroutine get_activity_by_id of $PACKAGE");
\@res;
}
sub get_perl_by_act_id{ # Return PERL code to call for a given Activity ID
use XML::Simple qw|XMLin XMLout|;
my ($invocant,$order_class,$wfp_id,$init_act_id) = @_;
$invocant->logger->debug("Entering subroutine get_activity_by_id of $PACKAGE");
my $act_xml = $invocant->get_activity_by_id($wfp_id,$init_act_id);
my $act_perl = XMLin($act_xml);
my $method = $act_perl->{'Implementation'}->{'Tool'}->{'Id'};
my $params = $act_perl->{'Implementation'}->{'Tool'}->{'ActualParameters'}->{'ActualParameter'};
my (@p,@params);
eval{@p = @$params;};
my $p;
if($@){
if (defined $params){
$invocant->{DataFields}->{$params} =~ s/'/\\'/g ;
$p =qq|'$params'=>'$invocant->{DataFields}->{$params}'|;
push @params,$p;
}
}else{
foreach(@p){
$invocant->{DataFields}->{$_} =~ s/'/\\'/g;
my $p = qq|'$_'=>'$invocant->{DataFields}->{$_}'|;
push @params,$p;
}
}
my $perl = $invocant->get_perl_by_method($order_class,$method,\@params); # get the perl code
$invocant->logger->debug("Leaving subroutine get_perl_by_act_id of $PACKAGE");
$perl;
}
sub get_conditions # Produces a hash from the Transaction (identified by 'From') subnodes of the workflow configuration file
{
my ($invocant,$wfp_id,$init_act_id) = @_;
$invocant->logger->debug("Entering subroutine get_conditions of $PACKAGE");
my $dest_act_id = $invocant->get_dest_act_id($wfp_id,$init_act_id); # get the XML leafs specifying 'From' ID
my @cond_hash;
my @operators = ('==','!=');
foreach (@$dest_act_id)
{
my $perl = XMLin($_);
my $dest = $perl->{'To'};
my $cond = $perl->{'Condition'};
if(ref $cond){ # OTHERWISE, EXCEPTION
push @cond_hash, {
'param' => '',
'value' => '',
'dest' => $dest,
'op' => $cond->{'Type'}, # OTHERWISE, EXCEPTION
};
}elsif($cond){ # var==, var!=
foreach my $op (@operators){
my @cond = split($op,$cond);
$cond[0] =~ s/\s//g; # paramter name without white spaces
if(defined $cond[1]){
$cond[1] = $1 if($cond[1] =~ m/^\s*\"(.*)\"\s*$/g);
push @cond_hash, {
'param' => $cond[0],
'value' => $cond[1], # undef if == is not in condition
'dest' => $dest,
'op' => $op,
};
};
}
}else{ # unconditioned dest
push @cond_hash, {
'param' => '',
'value' => '', # undef if == is not in condition
'dest' => $dest,
'op' => '',
};
}
}
$invocant->logger->debug("Leaving subroutine get_conditions of $PACKAGE");
\@cond_hash;
}
sub get_dest_id # This method is the first to be called by an application.
#For a given activity ID and a set of corresponding paramters produce the next activity ID
{
my ($invocant,
$lib, # 'Kai::Order::Simple'
$wfp_id, # 1
$wfp_name, # 'EOrder'
$wf,$wf_param, # setup paramters
# specify starting states for each workflow. Used by SubFlow only
$init_act_id, # setup paramter, {'EOrder' => [1],'FillOrder' => [1],'CreditCheck' => [1],}
$init_act_id_scalar # concret starting ID, e.g., 10
) = @_;
$invocant->logger->debug("Entering subroutine get_dest_id of $PACKAGE");
my $xml = $invocant->get_act_element($wfp_id->{$wfp_name},$init_act_id_scalar);
my $perl = XMLin($xml);
my %perl = %$perl;
my @chiave = keys(%perl);
my ($restriction,$action,$boolean,@refid); # in case that TransitionRestrictions exist
my $dest_unrest;
if(grep(/TransitionRestrictions/,@chiave)){
my $restr = $perl->{'TransitionRestrictions'}->{'TransitionRestriction'};
if(ref $restr->{'Split'}){
$action = 'Split';
}else{
$action = 'Join';
}
if($restr->{$action}->{'Type'} eq 'XOR'){
$boolean = 'XOR';
}else{
$boolean = 'AND';
}
my $ref_id = $restr->{$action}->{'TransitionRefs'}->{'TransitionRef'};
if($ref_id){
my @ref_id;
eval{ @ref_id = @$ref_id;};
push @ref_id, $ref_id if($@);
push @refid, $_->{'Id'} foreach(@ref_id);
$restriction = 1;
}else{
$restriction = 0;
}
}else{$restriction = 0;}
# if there is an implementation, we should call a method which can cause a change in the DataFields
if(grep(/Implementation/,@chiave)){
print "Implementation step\n";
my $subflow = $invocant->get_subflow($wfp_id->{$wfp_name},$init_act_id_scalar);
unless($subflow){
my $code = $invocant->get_perl_by_act_id($lib->{$wfp_name},$wfp_id->{$wfp_name},$init_act_id_scalar);
my $params_new = eval($code); # exe the perl code
$invocant->formal_parameters({'EXCEPTION' => {'SYSTEM' => $!,}}) if($@);
$invocant->data_fields($params_new)if(ref $params_new); # update $invocant->{DataFields}
$dest_unrest = $invocant->get_dest_from_transitions($wfp_id->{$wfp_name},$init_act_id_scalar); # dest list from transitions
# if no restriction on transition then go to Transition node
unless($restriction){ # lack of restriction: the dest list from transitions are the dest
$invocant->logger->debug("Leaving subroutine get_dest_id of $PACKAGE");
return $dest_unrest;
}else{ # with restrictions
$invocant->logger->debug("Leaving subroutine get_dest_id of $PACKAGE");
return $invocant->get_dest_id_with_restrictions($wfp_id->{$wfp_name},$boolean,\@refid,$dest_unrest);
}
}else{ # subprocess
# get WF ID
#my $wf_id; #TODO
#my $wfp_name = $invocant->get_wfpname_by_id($wf_id);
#my $out = $wf->{$wfp_name}->start_workflow($wfp_id->{$wfp_name},$wf_param,$init_act_id,$wfp_name);
return {}; # no support to Subprocess
}
}else{ # Route
my $code = $invocant->get_perl_by_act_id($lib->{$wfp_name},$wfp_id->{$wfp_name},$init_act_id_scalar);
my $params_new = eval($code); # exe the perl code
$invocant->formal_parameters({'EXCEPTION' => {'SYSTEM' => $!,}}) if($@);
$invocant->data_fields($params_new)if(ref $params_new); # update $invocant->{DataFields}
$dest_unrest = $invocant->get_dest_from_transitions($wfp_id->{$wfp_name},$init_act_id_scalar); # dest list from transitions
if($restriction){ # with restriction
print "Route step\n";
$invocant->logger->debug("Leaving subroutine get_dest_id of $PACKAGE");
return $invocant->get_dest_id_with_restrictions($wfp_id->{$wfp_name},$boolean,\@refid,$dest_unrest);
}else{
$invocant->logger->debug("Leaving subroutine get_dest_id of $PACKAGE");
return {}; # with Route and without Restriction is wrong
}
#TODO
}
}
sub get_dest_from_transitions # Return an array of raw destination IDs from the Transitions identified by a 'From' ID
{
my ($invocant,$wfp_id,$init_act_id) = @_;
$invocant->logger->debug("Entering subroutine get_dest_from_transitions of $PACKAGE");
my @dest;
my $cond = $invocant->get_conditions($wfp_id,$init_act_id);
foreach(@$cond){
if($_->{'op'} eq '=='){
if( $invocant->{DataFields}->{$_->{'param'}} eq $_->{'value'}){
push @dest, $_->{'dest'};
}
}
if($_->{'op'} eq '!='){
if( $invocant->{DataFields}->{$_->{'param'}} ne $_->{'value'}){
push @dest, $_->{'dest'};
}
}
}
foreach(@$cond){
if($_->{'op'} eq 'OTHERWISE'){ # TODO: 'EXCEPTION' not supported yet
push @dest, $_->{'dest'};
}
}
foreach(@$cond){
if($_->{'op'} eq ''){
push @dest, $_->{'dest'};
}
}
$invocant->logger->debug("Leaving subroutine get_dest_from_transitions of $PACKAGE");
return \@dest;
}
sub get_dest_id_with_restrictions # Controls a list of Transition reference IDs ($refid) and a list of raw destination IDs
# to produce the correct destination IDs
{
my ($invocant,$wfp_id,$boolean,$refid,$dest_unrest) = @_;
$invocant->logger->debug("Entering subroutine get_dest_id_with_restrictions of $PACKAGE");
my @dest;
foreach(@$refid){
my $xml = $invocant->get_transition($wfp_id,$_); # get dest id & condition by transition ref
if($xml){
my $perl = XMLin($xml);
my $to = $perl->{'To'};
push @dest, $to if(grep(/^$to$/,@$dest_unrest)); # valid only if restriction id in unrestricted list
return \@dest if($boolean eq 'XOR' && @dest); # TODO: return the first ID for 'XOR'
}
}
$invocant->logger->debug("Leaving subroutine get_dest_id_with_restrictions of $PACKAGE");
return \@dest; # return all for 'AND'
}
sub get_wfp_element
# Produces the WorkflowProcess (specified by workflow name) subnode of workflow configuration file, used by sub init_data_fields
{
my ($invocant,$wfp_id,$subnode) = @_;
$invocant->logger->debug("Entering subroutine get_wfp_element of $PACKAGE");
my $nodeset = $CONFIG->find(q|/Package/WorkflowProcesses/WorkflowProcess[@Id='|.$wfp_id.q|']/|.$subnode); # find all paragraphs
foreach my $node ($nodeset->get_nodelist)
{
$invocant->logger->debug("Leaving subroutine get_wfp_element of $PACKAGE");
return XML::XPath::XMLParser::as_string($node);
}
}
sub get_act_element
# Produces the Activity (specified by workflow name and Activity ID) subnode of workflow configuration file, used by sub get_act_id
{
my ($invocant,$wfp_id,$id,) = @_;
$invocant->logger->debug("Entering subroutine get_act_element of $PACKAGE");
my $nodeset = $CONFIG->find(q|/Package/WorkflowProcesses/WorkflowProcess[@Id='|.$wfp_id.q|']/Activities/Activity[@Id='|.$id.q|']|); # find all paragraphs
foreach my $node ($nodeset->get_nodelist)
{
$invocant->logger->debug("Leaving subroutine get_act_element of $PACKAGE");
return XML::XPath::XMLParser::as_string($node);
}
}
sub get_transition
# Produces the Transition (specified by workflow name and Transition ID) subnode of workflow configuration file, used by sub get_dest_id_with_restrictions
{
my ($invocant,$wfp_id,$id,) = @_;
$invocant->logger->debug("Entering subroutine get_transitions of $PACKAGE");
my $nodeset = $CONFIG->find(q|/Package/WorkflowProcesses/WorkflowProcess[@Id='|.$wfp_id.q|']/Transitions/Transition[@Id='|.$id.q|']|); # find all paragraphs
foreach my $node ($nodeset->get_nodelist)
{
$invocant->logger->debug("Leaving subroutine get_transitions of $PACKAGE");
return XML::XPath::XMLParser::as_string($node);
}
}
sub get_subflow
# Produces the Subflow (specified by workflow name and Activity ID) subnode of workflow configuration file, used by sub get_dest_id
{
my ($invocant,$wfp_id,$init_act_id,) = @_;
$invocant->logger->debug("Entering subroutine get_transitions of $PACKAGE");
my $nodeset = $CONFIG->find(q|/Package/WorkflowProcesses/WorkflowProcess[@Id='|.$wfp_id.q|']/Activities/Activity[@Id='|.$init_act_id.q|']/Implementation/SubFlow|); # find all SubFlows
foreach my $node ($nodeset->get_nodelist)
{
$invocant->logger->debug("Leaving subroutine get_transitions of $PACKAGE");
return XML::XPath::XMLParser::as_string($node);
}
}
sub start_workflow {
my ($invocant,
$wfp_id, # 1
$wf_param,$init_act_id, # setup parameters
$wf_name # 'EOrder'
) = @_;
$invocant->formal_parameters($wf_param->{$wfp_id->{$wf_name}}->{'IN'});
my @init_act_id;
eval{ @init_act_id = @{$init_act_id->{$wf_name}};};
push @init_act_id, $init_act_id->{$wf_name} if($@);
while(1){
my @dest_act_id = ();
foreach(@init_act_id) {
my $dest_act_id = $wf_param->{$wfp_id->{$wf_name}}->{'ACTION'}->{$_}->([$_],[]);
goto USCITA unless($dest_act_id); # exist if no destinition
eval{@dest_act_id = @$dest_act_id;};
goto USCITA if($@); # exit if no destinition
if($#dest_act_id > 0) { # multiple dest id
print "The next activity IDs are @dest_act_id\n\n";
}else{ # single dest id
print "The next activity ID is @dest_act_id\n\n";
}
if(@dest_act_id){
@init_act_id = @dest_act_id; # start from arrival
}else{
print "Process end point reached.\n";
goto USCITA; # exist if dest ID is 0
}
}
}
USCITA:
return $wf_param->{$wfp_id->{$wf_name}}->{'OUT'};
}
sub formal_parameters # set elements in FormalParameters and retrun a pointer to the FormalParameters
{
my ($invocant,$fp) = (shift,shift);
$invocant->logger->debug("Entering subroutine formal_parameters of $PACKAGE");
if(defined $fp){
my %fp = %$fp;
my @chiave = keys(%fp);
foreach(@chiave){
$invocant->{FormalParameters}->{$_} = $fp->{$_};
}
}
$invocant->logger->debug("Leaving subroutine formal_parameters of $PACKAGE");
return $invocant->{FormalParameters};
}
sub get_wfpname_by_id
# Produces the Transition (specified by workflow name and Transition ID) subnode of workflow configuration file, used by sub get_dest_id_with_restrictions
{
my ($invocant,$wfp_id) = @_;
$invocant->logger->debug("Entering subroutine get_transitions of $PACKAGE");
my $nodeset = $CONFIG->find(q|/Package/WorkflowProcesses/WorkflowProcess[@Id='|.$wfp_id.q|']|); # find all paragraphs
my $xml;
foreach my $node ($nodeset->get_nodelist)
{
$invocant->logger->debug("Leaving subroutine get_transitions of $PACKAGE");
$xml = XML::XPath::XMLParser::as_string($node);
last;
}
my $perl = XMLin($xml);
return $perl->{'Name'};
}
1;
__END__