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