line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Workflow::Condition::CheckReturn; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
31
|
|
4
|
1
|
|
|
1
|
|
10
|
use warnings; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
42
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '1.62'; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
5
|
use base qw( Workflow::Condition::Nested ); |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
114
|
|
9
|
1
|
|
|
1
|
|
14
|
use Workflow::Exception qw( condition_error configuration_error ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
70
|
|
10
|
1
|
|
|
1
|
|
7
|
use English qw( -no_match_vars ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
9
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors( 'condition', 'operator', 'argument' ); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my %supported_ops = ( |
15
|
|
|
|
|
|
|
eq => '==', |
16
|
|
|
|
|
|
|
lt => '<', |
17
|
|
|
|
|
|
|
gt => '>', |
18
|
|
|
|
|
|
|
le => '<=', |
19
|
|
|
|
|
|
|
ge => '>=', |
20
|
|
|
|
|
|
|
ne => '!=', |
21
|
|
|
|
|
|
|
); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub _init { |
24
|
3
|
|
|
3
|
|
7
|
my ( $self, $params ) = @_; |
25
|
|
|
|
|
|
|
|
26
|
3
|
50
|
|
|
|
8
|
unless ( defined $params->{condition} ) { |
27
|
0
|
|
|
|
|
0
|
configuration_error |
28
|
|
|
|
|
|
|
"You must specify the name of the nested condition in the parameter 'condition' for ", |
29
|
|
|
|
|
|
|
$self->name; |
30
|
|
|
|
|
|
|
} |
31
|
3
|
|
|
|
|
8
|
$self->condition( $params->{condition} ); |
32
|
|
|
|
|
|
|
|
33
|
3
|
50
|
|
|
|
30
|
unless ( defined $params->{operator} ) { |
34
|
0
|
|
|
|
|
0
|
configuration_error "You must define the value for 'operator' in ", |
35
|
|
|
|
|
|
|
"declaration of condition ", $self->name; |
36
|
|
|
|
|
|
|
} |
37
|
3
|
|
|
|
|
10
|
$self->operator( $params->{operator} ); |
38
|
|
|
|
|
|
|
|
39
|
3
|
50
|
|
|
|
28
|
unless ( defined $params->{argument} ) { |
40
|
0
|
|
|
|
|
0
|
configuration_error "You must define the value for 'argument' in ", |
41
|
|
|
|
|
|
|
"declaration of condition ", $self->name; |
42
|
|
|
|
|
|
|
} |
43
|
3
|
|
|
|
|
10
|
$self->argument( $params->{argument} ); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub evaluate { |
47
|
6
|
|
|
6
|
1
|
12
|
my ( $self, $wf ) = @_; |
48
|
6
|
|
|
|
|
25
|
my $cond = $self->condition; |
49
|
6
|
|
|
|
|
87
|
my $op = $self->operator; |
50
|
6
|
|
|
|
|
63
|
my $arg = $self->argument; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# warn "DEBUG: evaluating operator '$op'"; |
53
|
|
|
|
|
|
|
|
54
|
6
|
|
|
|
|
77
|
my $numop = $supported_ops{$op}; |
55
|
6
|
50
|
|
|
|
18
|
if ( not $numop ) { |
56
|
0
|
|
|
|
|
0
|
configuration_error "Unsupported operator '$op'"; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Fetch argument from context or eval, if necessary |
60
|
6
|
|
|
|
|
8
|
my $argval; |
61
|
6
|
50
|
|
|
|
36
|
if ( $arg =~ /^[-]?\d+$/ ) { # numeric |
|
|
0
|
|
|
|
|
|
62
|
6
|
|
|
|
|
13
|
$argval = $arg; |
63
|
|
|
|
|
|
|
} elsif ( $arg =~ /^[a-zA-Z0-9_]+$/ ) { # alpha-numeric, plus '_' |
64
|
0
|
|
|
|
|
0
|
$argval = $wf->context->param($arg); |
65
|
|
|
|
|
|
|
} else { |
66
|
0
|
|
|
|
|
0
|
local $EVAL_ERROR = undef; |
67
|
0
|
|
|
|
|
0
|
$argval = eval $arg; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
6
|
|
|
|
|
25
|
my $condval = $self->evaluate_condition( $wf, $cond ); |
71
|
|
|
|
|
|
|
|
72
|
6
|
|
|
|
|
59
|
local $EVAL_ERROR = undef; |
73
|
6
|
100
|
|
|
|
357
|
if ( eval "\$condval $op \$argval" ) { |
74
|
2
|
|
|
|
|
11
|
return 1; |
75
|
|
|
|
|
|
|
} else { |
76
|
4
|
|
|
|
|
27
|
condition_error "Condition failed: '$condval' $op '$argval'"; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
configuration_error |
80
|
|
|
|
|
|
|
"Unknown error in CheckReturn.pm: cond=$cond, op=$op, arg=$arg"; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
1; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
__END__ |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=pod |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head1 NAME |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Workflow::Condition::CheckReturn |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head1 VERSION |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
This documentation describes version 1.62 of this package |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head1 DESCRIPTION |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
Using nested conditions (See Workflow::Condition::Nested), this evaluates |
100
|
|
|
|
|
|
|
a given condition and compares the value returned with a given argument. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=head1 SYNOPSIS |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
In condition.xml: |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
<condition name="check_approvals" class="Workflow::Condition::CheckReturn"> |
107
|
|
|
|
|
|
|
<param name="condition" value="count_approvals" /> |
108
|
|
|
|
|
|
|
<!-- operator "ge" means: greater than or equal to --> |
109
|
|
|
|
|
|
|
<param name="operator" value="ge" /> |
110
|
|
|
|
|
|
|
<param name="argument" value="$context->{approvals_needed}" /> |
111
|
|
|
|
|
|
|
</condition> |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
In workflow.xml: |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
<state name="CHECK_APPROVALS" autorun="yes"> |
116
|
|
|
|
|
|
|
<action name="null_1" resulting_state="APPROVED"> |
117
|
|
|
|
|
|
|
<condition name="check_approvals" /> |
118
|
|
|
|
|
|
|
</action> |
119
|
|
|
|
|
|
|
<action name="null_2" resulting_state="REJECTED"> |
120
|
|
|
|
|
|
|
<condition name="!check_approvals" /> |
121
|
|
|
|
|
|
|
</action> |
122
|
|
|
|
|
|
|
</state> |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=cut |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head1 PARAMETERS |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
The following parameters may be configured in the C<param> entity of the |
129
|
|
|
|
|
|
|
condition in the XML configuration: |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=head2 condition |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
The name of the condition to be evaluated. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 argument |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
The value to compare with the given condition. This can be one of the following: |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=over |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=item Integer |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
The integer value is compared with the return value of the condition. |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=item String [a-zA-Z0-9_] |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
The string is interpreted as the name of a workflow context parameter. The current |
148
|
|
|
|
|
|
|
value of that parmeter is used in the comparison. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=item String |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Any other string is evaluated in an C<eval> block. The result should be numeric. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=back |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head2 operator |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
The name of the comparison operator to use. Supported values are: |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
'eq', 'lt', 'gt', 'le', 'ge', 'ne' |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
The string names are used to simplify the notation in the XML files. The |
163
|
|
|
|
|
|
|
above strings map to the following numeric operators internally: |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
'==', '<', '>', '<=', '>=', != |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head1 COPYRIGHT |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Copyright (c) 2004-2023 Chris Winters. All rights reserved. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
172
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Please see the F<LICENSE> |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head1 AUTHORS |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
Please see L<Workflow> |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=cut |