line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use warnings; |
3
|
21
|
|
|
21
|
|
615425
|
use strict; |
|
21
|
|
|
|
|
62
|
|
|
21
|
|
|
|
|
767
|
|
4
|
21
|
|
|
21
|
|
109
|
use base qw( Workflow::Base ); |
|
21
|
|
|
|
|
33
|
|
|
21
|
|
|
|
|
652
|
|
5
|
21
|
|
|
21
|
|
102
|
use Carp qw(croak); |
|
21
|
|
|
|
|
42
|
|
|
21
|
|
|
|
|
2928
|
|
6
|
21
|
|
|
21
|
|
137
|
use English qw( -no_match_vars ); |
|
21
|
|
|
|
|
54
|
|
|
21
|
|
|
|
|
1167
|
|
7
|
21
|
|
|
21
|
|
2400
|
use Log::Log4perl qw( get_logger ); |
|
21
|
|
|
|
|
7629
|
|
|
21
|
|
|
|
|
157
|
|
8
|
21
|
|
|
21
|
|
7079
|
use Workflow::Exception qw( workflow_error condition_error ); |
|
21
|
|
|
|
|
47
|
|
|
21
|
|
|
|
|
170
|
|
9
|
21
|
|
|
21
|
|
2671
|
|
|
21
|
|
|
|
|
53
|
|
|
21
|
|
|
|
|
11870
|
|
10
|
|
|
|
|
|
|
$Workflow::Condition::CACHE_RESULTS = 1; |
11
|
|
|
|
|
|
|
$Workflow::Condition::VERSION = '1.60'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my $log; |
14
|
|
|
|
|
|
|
my @FIELDS = qw( name class ); |
15
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(@FIELDS); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my ( $self, $params ) = @_; |
18
|
|
|
|
|
|
|
$self->name( $params->{name} ); |
19
|
70
|
|
|
70
|
1
|
143
|
$self->class( $params->{class} ); |
20
|
70
|
|
|
|
|
355
|
$self->_init($params); |
21
|
70
|
|
|
|
|
1408
|
} |
22
|
70
|
|
|
|
|
763
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my ($self) = @_; |
25
|
26
|
|
|
26
|
|
61
|
croak "Class ", ref($self), " must implement 'evaluate()'!\n"; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
1
|
|
|
1
|
1
|
634
|
|
29
|
1
|
|
|
|
|
24
|
my ( $class, $wf, $condition_name) = @_; |
30
|
|
|
|
|
|
|
$log ||= get_logger(); |
31
|
|
|
|
|
|
|
$wf->type; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my $factory = $wf->_factory(); |
34
|
171
|
|
|
171
|
1
|
803
|
my $orig_condition = $condition_name; |
35
|
171
|
|
66
|
|
|
417
|
my $condition; |
36
|
171
|
|
|
|
|
2573
|
|
37
|
|
|
|
|
|
|
$log->debug("Checking condition $condition_name"); |
38
|
171
|
|
|
|
|
1603
|
|
39
|
171
|
|
|
|
|
1324
|
local $wf->{'_condition_result_cache'} = |
40
|
171
|
|
|
|
|
203
|
$wf->{'_condition_result_cache'} || {}; |
41
|
|
|
|
|
|
|
if ( $Workflow::Condition::CACHE_RESULTS |
42
|
171
|
|
|
|
|
552
|
&& exists $wf->{'_condition_result_cache'}->{$orig_condition} ) { |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $cache_value = $wf->{'_condition_result_cache'}->{$orig_condition}; |
45
|
171
|
|
100
|
|
|
27558
|
# The condition has already been evaluated and the result |
46
|
171
|
100
|
100
|
|
|
736
|
# has been cached |
47
|
|
|
|
|
|
|
$log->debug( |
48
|
|
|
|
|
|
|
"Condition has been cached: '$orig_condition', cached result: ", |
49
|
25
|
|
|
|
|
49
|
$cache_value || '' |
50
|
|
|
|
|
|
|
); |
51
|
|
|
|
|
|
|
|
52
|
25
|
|
100
|
|
|
142
|
return $cache_value; |
53
|
|
|
|
|
|
|
} else { |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# we did not evaluate the condition yet, we have to do |
56
|
|
|
|
|
|
|
# it now |
57
|
25
|
|
|
|
|
4896
|
$condition = $wf->_factory() |
58
|
|
|
|
|
|
|
->get_condition( $orig_condition, $wf->type ); |
59
|
|
|
|
|
|
|
$log->debug( "Evaluating condition '$orig_condition'" ); |
60
|
|
|
|
|
|
|
my $return_value; |
61
|
|
|
|
|
|
|
eval { $return_value = $condition->evaluate($wf) }; |
62
|
146
|
|
|
|
|
355
|
if ($EVAL_ERROR) { |
63
|
|
|
|
|
|
|
|
64
|
146
|
|
|
|
|
562
|
# Check if this is a Workflow::Exception::Condition |
65
|
146
|
|
|
|
|
21014
|
if (Exception::Class->caught('Workflow::Exception::Condition')) { |
66
|
146
|
|
|
|
|
181
|
$wf->{'_condition_result_cache'}->{$orig_condition} = 0; |
|
146
|
|
|
|
|
977
|
|
67
|
146
|
100
|
|
|
|
78744
|
$log->debug( |
68
|
|
|
|
|
|
|
"condition '$orig_condition' failed due to: $EVAL_ERROR"); |
69
|
|
|
|
|
|
|
return 0; |
70
|
57
|
50
|
|
|
|
608
|
# unreachable |
71
|
57
|
|
|
|
|
984
|
|
72
|
57
|
|
|
|
|
343
|
} else { |
73
|
|
|
|
|
|
|
$log->debug("Got uncatchable exception in condition $condition_name "); |
74
|
57
|
|
|
|
|
102657
|
|
75
|
|
|
|
|
|
|
# if EVAL_ERROR is an execption object rethrow it |
76
|
|
|
|
|
|
|
$EVAL_ERROR->rethrow() if (ref $EVAL_ERROR ne ''); |
77
|
|
|
|
|
|
|
|
78
|
0
|
|
|
|
|
0
|
# if it is a string (bubbled up from die/croak), make an Exception Object |
79
|
|
|
|
|
|
|
# For briefness, we just send back the first line of EVAL |
80
|
|
|
|
|
|
|
my @t = split /\n/, $EVAL_ERROR; |
81
|
0
|
0
|
|
|
|
0
|
my $ee = shift @t; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
Exception::Class::Base->throw( error |
84
|
|
|
|
|
|
|
=> "Got unknown exception while handling condition '$condition_name' / " . $ee ); |
85
|
0
|
|
|
|
|
0
|
# unreachable |
86
|
0
|
|
|
|
|
0
|
|
87
|
|
|
|
|
|
|
} |
88
|
0
|
|
|
|
|
0
|
# unreachable |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
} else { |
91
|
|
|
|
|
|
|
$wf->{'_condition_result_cache'}->{$orig_condition} = $return_value; |
92
|
|
|
|
|
|
|
$log->debug("condition '$orig_condition' succeeded; returned: ", |
93
|
|
|
|
|
|
|
$return_value ? 'true' : 'false'); |
94
|
|
|
|
|
|
|
return $return_value; |
95
|
|
|
|
|
|
|
} |
96
|
89
|
|
|
|
|
325
|
# unreachable |
97
|
89
|
100
|
|
|
|
455
|
|
98
|
|
|
|
|
|
|
} |
99
|
89
|
|
|
|
|
13499
|
# unreachable |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
1; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=pod |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head1 NAME |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Workflow::Condition - Evaluate a condition depending on the workflow state and environment |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head1 VERSION |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
This documentation describes version 1.60 of this package |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head1 SYNOPSIS |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# First declare the condition in a 'workflow_condition.xml'... |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
<conditions> |
122
|
|
|
|
|
|
|
<condition |
123
|
|
|
|
|
|
|
name="IsAdminUser" |
124
|
|
|
|
|
|
|
class="MyApp::Condition::IsAdminUser"> |
125
|
|
|
|
|
|
|
<param name="admin_group_id" value="5" /> |
126
|
|
|
|
|
|
|
<param name="admin_group_id" value="6" /> |
127
|
|
|
|
|
|
|
</condition> |
128
|
|
|
|
|
|
|
... |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# Reference the condition in an action of the state/workflow definition... |
131
|
|
|
|
|
|
|
<workflow> |
132
|
|
|
|
|
|
|
<state> |
133
|
|
|
|
|
|
|
... |
134
|
|
|
|
|
|
|
<action name="SomeAdminAction"> |
135
|
|
|
|
|
|
|
... |
136
|
|
|
|
|
|
|
<condition name="IsAdminUser" /> |
137
|
|
|
|
|
|
|
</action> |
138
|
|
|
|
|
|
|
<action name="AnotherAdminAction"> |
139
|
|
|
|
|
|
|
... |
140
|
|
|
|
|
|
|
<condition name="IsAdminUser" /> |
141
|
|
|
|
|
|
|
</action> |
142
|
|
|
|
|
|
|
<action name="AUserAction"> |
143
|
|
|
|
|
|
|
... |
144
|
|
|
|
|
|
|
<condition name="!IsAdminUser" /> |
145
|
|
|
|
|
|
|
</action> |
146
|
|
|
|
|
|
|
</state> |
147
|
|
|
|
|
|
|
... |
148
|
|
|
|
|
|
|
</workflow> |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# Then implement the condition |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
package MyApp::Condition::IsAdminUser; |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
use strict; |
155
|
|
|
|
|
|
|
use base qw( Workflow::Condition ); |
156
|
|
|
|
|
|
|
use Workflow::Exception qw( condition_error configuration_error ); |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors( 'admin_group_id' ); |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub _init { |
161
|
|
|
|
|
|
|
my ( $self, $params ) = @_; |
162
|
|
|
|
|
|
|
unless ( $params->{admin_group_id} ) { |
163
|
|
|
|
|
|
|
configuration_error |
164
|
|
|
|
|
|
|
"You must define one or more values for 'admin_group_id' in ", |
165
|
|
|
|
|
|
|
"declaration of condition ", $self->name; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
my @admin_ids = $self->_normalize_array( $params->{admin_group_id} ); |
168
|
|
|
|
|
|
|
$self->admin_group_id( { map { $_ => 1 } @admin_ids } ); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub evaluate { |
172
|
|
|
|
|
|
|
my ( $self, $wf ) = @_; |
173
|
|
|
|
|
|
|
my $admin_ids = $self->admin_group_id; |
174
|
|
|
|
|
|
|
my $current_user = $wf->context->param( 'current_user' ); |
175
|
|
|
|
|
|
|
unless ( $current_user ) { |
176
|
|
|
|
|
|
|
condition_error "No user defined, cannot check groups"; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
foreach my $group ( @{ $current_user->get_groups } ) { |
179
|
|
|
|
|
|
|
return if ( $admin_ids->{ $group->id } ); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
condition_error "Not member of any Admin groups"; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head1 DESCRIPTION |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Conditions are used by the workflow to see whether actions are |
187
|
|
|
|
|
|
|
available in a particular context. So if user A asks the workflow for |
188
|
|
|
|
|
|
|
the available actions she might get a different answer than user B |
189
|
|
|
|
|
|
|
since they determine separate contexts. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
B<NOTE>: The condition is enforced by Workflow::State. This means that |
192
|
|
|
|
|
|
|
the condition name must be visible inside of the state definition. If |
193
|
|
|
|
|
|
|
you specify the reference to the condition only inside of the full |
194
|
|
|
|
|
|
|
action specification in a seperate file then nothing will happen. The |
195
|
|
|
|
|
|
|
reference to the condition must be defined inside of the state/workflow |
196
|
|
|
|
|
|
|
specification. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head1 CONFIGURATION |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
While some conditions apply to all workflows, you may have a case where |
201
|
|
|
|
|
|
|
a condition has different implementations for different workflow types. |
202
|
|
|
|
|
|
|
For example, IsAdminUser may look in two different places for two |
203
|
|
|
|
|
|
|
different workflow types, but you want to use the same condition name |
204
|
|
|
|
|
|
|
for both. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
You can accomplish this by adding a type in the condition configuration. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
<conditions> |
209
|
|
|
|
|
|
|
<type>Ticket</type> |
210
|
|
|
|
|
|
|
<condition |
211
|
|
|
|
|
|
|
name="IsAdminUser" |
212
|
|
|
|
|
|
|
class="MyApp::Condition::IsAdminUser"> |
213
|
|
|
|
|
|
|
<param name="admin_group_id" value="5" /> |
214
|
|
|
|
|
|
|
<param name="admin_group_id" value="6" /> |
215
|
|
|
|
|
|
|
</condition> |
216
|
|
|
|
|
|
|
... |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
The type must match a loaded workflow type, or the condition won't work. |
219
|
|
|
|
|
|
|
When the workflow looks for a condition, it will look for a typed condition |
220
|
|
|
|
|
|
|
first. If it doesn't find one, it will look for non-typed conditions. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head1 SUBCLASSING |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head2 Strategy |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
The idea behind conditions is that they can be stateless. So when the |
227
|
|
|
|
|
|
|
L<Workflow::Factory> object reads in the condition configuration it |
228
|
|
|
|
|
|
|
creates the condition objects and initializes them with whatever |
229
|
|
|
|
|
|
|
information is passed in. |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Then when the condition is evaluated we just call C<evaluate()> on the |
232
|
|
|
|
|
|
|
condition. Hopefully the operation can be done very quickly since the |
233
|
|
|
|
|
|
|
condition may be called many, many times during a workflow lifecycle |
234
|
|
|
|
|
|
|
-- they are typically used to show users what options they have given |
235
|
|
|
|
|
|
|
the current state of the workflow for things like menu options. So |
236
|
|
|
|
|
|
|
keep it short! |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=head2 Methods |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
To create your own condition you should implement the following: |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head3 init( \%params ) |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
This is optional, but called when the condition is first |
245
|
|
|
|
|
|
|
initialized. It may contain information you will want to initialize |
246
|
|
|
|
|
|
|
your condition with in C<\%params>, which are all the declared |
247
|
|
|
|
|
|
|
parameters in the condition declartion except for 'class' and 'name'. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
You may also do any initialization here -- you can fetch data from the |
250
|
|
|
|
|
|
|
database and store it in the class or object, whatever you need. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
If you do not have sufficient information in C<\%params> you should |
253
|
|
|
|
|
|
|
throw an exception (preferably 'configuration_error' imported from |
254
|
|
|
|
|
|
|
L<Workflow::Exception>). |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=head3 evaluate( $workflow ) |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
Determine whether your condition fails by throwing an exception. You |
259
|
|
|
|
|
|
|
can get the application context information necessary to process your |
260
|
|
|
|
|
|
|
condition from the C<$workflow> object. |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=head3 _init |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
This is a I<dummy>, please refer to L</init> |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head2 Caching and inverting the result |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
If in one state, you ask for the same condition again, Workflow uses |
269
|
|
|
|
|
|
|
the cached result, so that within one list of available actions, you |
270
|
|
|
|
|
|
|
will get a consistent view. Note that if we would not use caching, |
271
|
|
|
|
|
|
|
this might not necessary be the case, as something external might |
272
|
|
|
|
|
|
|
change between the two evaluate() calls. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
Caching is also used with an inverted condition, which you can specify |
275
|
|
|
|
|
|
|
in the definition using C<<condition name="!some_condition">>. |
276
|
|
|
|
|
|
|
This condition returns the negation of the original one, i.e. |
277
|
|
|
|
|
|
|
if the original condition fails, this one does not and the other way |
278
|
|
|
|
|
|
|
round. As caching is used, you can model "yes/no" decisions using this |
279
|
|
|
|
|
|
|
feature - if you have both C<<condition name="some_condition">> and |
280
|
|
|
|
|
|
|
C<<condition name="!some_condition">> in your workflow state definition, |
281
|
|
|
|
|
|
|
exactly one of them will succeed and one will fail - which is particularly |
282
|
|
|
|
|
|
|
useful if you use "autorun" a lot. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
Caching can be disabled by changing C<$Workflow::Condition::CACHE_RESULTS> |
285
|
|
|
|
|
|
|
to zero (0): |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
$Workflow::Condition::CACHE_RESULTS = 0; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
All versions before 1.49 used a mechanism that effectively caused global |
290
|
|
|
|
|
|
|
state. To address the problems that resulted (see GitHub issues #9 and #7), |
291
|
|
|
|
|
|
|
1.49 switched to a new mechanism with a cache per workflow instance. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=head3 $class->evaluate_condition( $WORKFLOW, $CONDITION_NAME ) |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
Users call this method to evaluate a condition; subclasses call this |
297
|
|
|
|
|
|
|
method to evaluate a nested condition. |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
If the condition name starts with an '!', the result of the condition |
300
|
|
|
|
|
|
|
is negated. Note that a side-effect of this is that the return |
301
|
|
|
|
|
|
|
value of the condition is ignored. Only the negated boolean-ness |
302
|
|
|
|
|
|
|
is preserved. |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
This does implement a trick that is not a convention in the underlying |
305
|
|
|
|
|
|
|
Workflow library: by default, workflow conditions throw an error when |
306
|
|
|
|
|
|
|
the condition is false and just return when the condition is true. To |
307
|
|
|
|
|
|
|
allow for counting the true conditions, we also look at the return |
308
|
|
|
|
|
|
|
value here. If a condition returns zero or an undefined value, but |
309
|
|
|
|
|
|
|
did not throw an exception, we consider it to be '1'. Otherwise, we |
310
|
|
|
|
|
|
|
consider it to be the value returned. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=head1 COPYRIGHT |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
Copyright (c) 2003-2022 Chris Winters. All rights reserved. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
319
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
Please see the F<LICENSE> |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=head1 AUTHORS |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
Please see L<Workflow> |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=cut |