line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use warnings; |
3
|
20
|
|
|
20
|
|
1380255
|
use strict; |
|
20
|
|
|
|
|
92
|
|
|
20
|
|
|
|
|
690
|
|
4
|
20
|
|
|
20
|
|
151
|
use base qw( Workflow::Base ); |
|
20
|
|
|
|
|
36
|
|
|
20
|
|
|
|
|
478
|
|
5
|
20
|
|
|
20
|
|
89
|
use DateTime; |
|
20
|
|
|
|
|
41
|
|
|
20
|
|
|
|
|
3926
|
|
6
|
20
|
|
|
20
|
|
962
|
use Log::Log4perl qw( get_logger ); |
|
20
|
|
|
|
|
458960
|
|
|
20
|
|
|
|
|
550
|
|
7
|
20
|
|
|
20
|
|
92
|
use Workflow::Exception qw( configuration_error workflow_error ); |
|
20
|
|
|
|
|
35
|
|
|
20
|
|
|
|
|
120
|
|
8
|
20
|
|
|
20
|
|
4084
|
use Carp qw(croak); |
|
20
|
|
|
|
|
46
|
|
|
20
|
|
|
|
|
1102
|
|
9
|
20
|
|
|
20
|
|
108
|
use English qw( -no_match_vars ); |
|
20
|
|
|
|
|
28
|
|
|
20
|
|
|
|
|
925
|
|
10
|
20
|
|
|
20
|
|
5288
|
$Workflow::Factory::VERSION = '1.61'; |
|
20
|
|
|
|
|
16729
|
|
|
20
|
|
|
|
|
105
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Extra action attribute validation is off by default for compatibility. |
13
|
|
|
|
|
|
|
our $VALIDATE_ACTION_CONFIG = 0; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my (%INSTANCES); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $class = shift; |
18
|
|
|
|
|
|
|
|
19
|
95
|
|
|
95
|
|
225272
|
$class = ref $class || $class; # just in case |
20
|
|
|
|
|
|
|
my $package = caller; |
21
|
95
|
|
33
|
|
|
474
|
my $log = get_logger(__PACKAGE__); |
22
|
95
|
|
|
|
|
211
|
if ( defined $_[0] && $_[0] eq 'FACTORY' ) { |
23
|
95
|
|
|
|
|
959
|
shift; |
24
|
95
|
100
|
66
|
|
|
10950
|
my $instance; |
25
|
93
|
|
|
|
|
115
|
|
26
|
93
|
|
|
|
|
120
|
my $import_target = $package . '::FACTORY'; |
27
|
|
|
|
|
|
|
no strict 'refs'; |
28
|
93
|
|
|
|
|
180
|
unless ( defined &{$import_target} ) { |
29
|
20
|
|
|
20
|
|
7900
|
*{$import_target} = sub { |
|
20
|
|
|
|
|
61
|
|
|
20
|
|
|
|
|
29435
|
|
30
|
93
|
50
|
|
|
|
124
|
return $instance if $instance; |
|
93
|
|
|
|
|
509
|
|
31
|
93
|
|
|
|
|
332
|
$instance = _initialize_instance($class); |
32
|
23
|
100
|
|
23
|
|
8485
|
return $instance; |
33
|
16
|
|
|
|
|
55
|
}; |
34
|
16
|
|
|
|
|
100
|
} |
35
|
93
|
|
|
|
|
349
|
} |
36
|
|
|
|
|
|
|
$class->SUPER::import(@_); |
37
|
|
|
|
|
|
|
} |
38
|
95
|
|
|
|
|
432
|
|
39
|
|
|
|
|
|
|
require Workflow; |
40
|
|
|
|
|
|
|
require Workflow::Action; |
41
|
|
|
|
|
|
|
require Workflow::Condition; |
42
|
|
|
|
|
|
|
require Workflow::Condition::Negated; |
43
|
|
|
|
|
|
|
require Workflow::Config; |
44
|
|
|
|
|
|
|
require Workflow::Context; |
45
|
|
|
|
|
|
|
require Workflow::History; |
46
|
|
|
|
|
|
|
require Workflow::Persister; |
47
|
|
|
|
|
|
|
require Workflow::State; |
48
|
|
|
|
|
|
|
require Workflow::Validator; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my $DEFAULT_INITIAL_STATE = 'INITIAL'; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
my @FIELDS = qw(config_callback); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(@FIELDS); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my $proto = shift; |
57
|
|
|
|
|
|
|
my $class = ref $proto || $proto; |
58
|
|
|
|
|
|
|
|
59
|
2
|
|
|
2
|
1
|
1065
|
workflow_error "Please call 'instance()' or import the 'FACTORY' object ", |
60
|
2
|
|
33
|
|
|
16
|
"to get the '$class' object rather than instantiating a ", |
61
|
|
|
|
|
|
|
"new one directly."; |
62
|
2
|
|
|
|
|
9
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
my $proto = shift; |
65
|
|
|
|
|
|
|
my $class = ref $proto || $proto; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
return _initialize_instance($class); |
68
|
30
|
|
|
30
|
1
|
23117
|
} |
69
|
30
|
|
33
|
|
|
150
|
|
70
|
|
|
|
|
|
|
my ($class) = @_; |
71
|
30
|
|
|
|
|
88
|
|
72
|
|
|
|
|
|
|
my $log = get_logger(__PACKAGE__); |
73
|
|
|
|
|
|
|
unless ( $INSTANCES{$class} ) { |
74
|
|
|
|
|
|
|
$log->debug( "Creating empty instance of '$class' factory for ", |
75
|
46
|
|
|
46
|
|
101
|
"singleton use" ); |
76
|
|
|
|
|
|
|
my $instance = bless {} => $class; |
77
|
46
|
|
|
|
|
140
|
$instance->init(); |
78
|
46
|
100
|
|
|
|
1633
|
$INSTANCES{$class} = $instance; |
79
|
17
|
|
|
|
|
107
|
} |
80
|
|
|
|
|
|
|
return $INSTANCES{$class}; |
81
|
17
|
|
|
|
|
7331
|
} |
82
|
17
|
|
|
|
|
160
|
|
83
|
17
|
|
|
|
|
37
|
my ($class) = @_; |
84
|
|
|
|
|
|
|
|
85
|
46
|
|
|
|
|
131
|
my $log = get_logger(__PACKAGE__); |
86
|
|
|
|
|
|
|
if ( $INSTANCES{$class} ) { |
87
|
|
|
|
|
|
|
$log->debug( "Deleting instance of '$class' factory." ); |
88
|
|
|
|
|
|
|
delete $INSTANCES{$class}; |
89
|
0
|
|
|
0
|
|
0
|
} else { |
90
|
|
|
|
|
|
|
$log->debug( "No instance of '$class' factory found." ); |
91
|
0
|
|
|
|
|
0
|
} |
92
|
0
|
0
|
|
|
|
0
|
|
93
|
0
|
|
|
|
|
0
|
return; |
94
|
0
|
|
|
|
|
0
|
} |
95
|
|
|
|
|
|
|
|
96
|
0
|
|
|
|
|
0
|
my %CONFIG = ( 'Workflow::Config' => 1 ); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
my ( $self, %params ) = @_; |
99
|
0
|
|
|
|
|
0
|
return unless ( scalar keys %params ); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
_check_config_keys(%params); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
foreach my $type ( sort keys %params ) { |
104
|
|
|
|
|
|
|
$self->log->debug( |
105
|
16
|
|
|
16
|
1
|
1901
|
sub { "Using '$type' configuration file(s): " . |
106
|
16
|
50
|
|
|
|
94
|
join( ', ', _flatten( $params{$type} ) ) } ); |
107
|
|
|
|
|
|
|
} |
108
|
16
|
|
|
|
|
80
|
|
109
|
|
|
|
|
|
|
$self->log->debug( "Adding condition configurations..." ); |
110
|
16
|
|
|
|
|
92
|
|
111
|
|
|
|
|
|
|
if ( ref $params{condition} eq 'ARRAY' ) { |
112
|
|
|
|
|
|
|
foreach my $condition ( @{ $params{condition} } ) { |
113
|
57
|
|
|
54
|
|
11326
|
$self->_add_condition_config( |
|
54
|
|
|
|
|
1100
|
|
114
|
|
|
|
|
|
|
Workflow::Config->parse_all_files( 'condition', $condition ) |
115
|
|
|
|
|
|
|
); |
116
|
16
|
|
|
|
|
4187
|
} |
117
|
|
|
|
|
|
|
} else { |
118
|
16
|
100
|
|
|
|
4363
|
$self->_add_condition_config( |
119
|
10
|
|
|
|
|
22
|
Workflow::Config->parse_all_files( |
|
10
|
|
|
|
|
28
|
|
120
|
20
|
|
|
|
|
3090
|
'condition', $params{condition} |
121
|
|
|
|
|
|
|
) |
122
|
|
|
|
|
|
|
); |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
$self->log->debug( "Adding validator configurations..." ); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
if ( ref $params{validator} eq 'ARRAY' ) { |
128
|
|
|
|
|
|
|
foreach my $validator ( @{ $params{validator} } ) { |
129
|
6
|
|
|
|
|
34
|
$self->_add_validator_config( |
130
|
|
|
|
|
|
|
Workflow::Config->parse_all_files( 'validator', $validator ) |
131
|
|
|
|
|
|
|
); |
132
|
16
|
|
|
|
|
4203
|
} |
133
|
|
|
|
|
|
|
} else { |
134
|
16
|
100
|
|
|
|
4345
|
$self->_add_validator_config( |
135
|
1
|
|
|
|
|
3
|
Workflow::Config->parse_all_files( |
|
1
|
|
|
|
|
2
|
|
136
|
2
|
|
|
|
|
337
|
'validator', $params{validator} |
137
|
|
|
|
|
|
|
) |
138
|
|
|
|
|
|
|
); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
$self->log->debug( "Adding persister configurations..." ); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
if ( ref $params{persister} eq 'ARRAY' ) { |
144
|
|
|
|
|
|
|
foreach my $persister ( @{ $params{persister} } ) { |
145
|
15
|
|
|
|
|
123
|
$self->_add_persister_config( |
146
|
|
|
|
|
|
|
Workflow::Config->parse_all_files( 'persister', $persister ) |
147
|
|
|
|
|
|
|
); |
148
|
16
|
|
|
|
|
3699
|
} |
149
|
|
|
|
|
|
|
} else { |
150
|
16
|
50
|
|
|
|
4435
|
$self->_add_persister_config( |
151
|
0
|
|
|
|
|
0
|
Workflow::Config->parse_all_files( |
|
0
|
|
|
|
|
0
|
|
152
|
0
|
|
|
|
|
0
|
'persister', $params{persister} |
153
|
|
|
|
|
|
|
) |
154
|
|
|
|
|
|
|
); |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
$self->log->debug( "Adding action configurations..." ); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
if ( ref $params{action} eq 'ARRAY' ) { |
160
|
|
|
|
|
|
|
foreach my $action ( @{ $params{action} } ) { |
161
|
16
|
|
|
|
|
151
|
$self->_add_action_config( |
162
|
|
|
|
|
|
|
Workflow::Config->parse_all_files( 'action', $action ) ); |
163
|
|
|
|
|
|
|
} |
164
|
16
|
|
|
|
|
65
|
} else { |
165
|
|
|
|
|
|
|
$self->_add_action_config( |
166
|
16
|
100
|
|
|
|
4436
|
Workflow::Config->parse_all_files( 'action', $params{action} ) ); |
167
|
10
|
|
|
|
|
21
|
} |
|
10
|
|
|
|
|
38
|
|
168
|
21
|
|
|
|
|
133
|
|
169
|
|
|
|
|
|
|
$self->log->debug( "Adding workflow configurations..." ); |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
if ( ref $params{workflow} eq 'ARRAY' ) { |
172
|
|
|
|
|
|
|
foreach my $workflow ( @{ $params{workflow} } ) { |
173
|
6
|
|
|
|
|
31
|
$self->_add_workflow_config( |
174
|
|
|
|
|
|
|
Workflow::Config->parse_all_files( 'workflow', $workflow ) ); |
175
|
|
|
|
|
|
|
} |
176
|
16
|
|
|
|
|
104
|
} else { |
177
|
|
|
|
|
|
|
$self->_add_workflow_config( |
178
|
16
|
100
|
|
|
|
4495
|
Workflow::Config->parse_all_files( |
179
|
10
|
|
|
|
|
23
|
'workflow', $params{workflow} |
|
10
|
|
|
|
|
133
|
|
180
|
28
|
|
|
|
|
202
|
) |
181
|
|
|
|
|
|
|
); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
return; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
my ( $self, %params ) = @_; |
188
|
6
|
|
|
|
|
48
|
return unless ( scalar keys %params ); |
189
|
|
|
|
|
|
|
_check_config_keys(%params); |
190
|
|
|
|
|
|
|
$self->_add_condition_config( _flatten( $params{condition} ) ); |
191
|
16
|
|
|
|
|
274
|
$self->_add_validator_config( _flatten( $params{validator} ) ); |
192
|
|
|
|
|
|
|
$self->_add_persister_config( _flatten( $params{persister} ) ); |
193
|
|
|
|
|
|
|
$self->_add_action_config( _flatten( $params{action} ) ); |
194
|
|
|
|
|
|
|
$self->_add_workflow_config( _flatten( $params{workflow} ) ); |
195
|
25
|
|
|
25
|
1
|
18822
|
return; |
196
|
25
|
50
|
|
|
|
104
|
} |
197
|
25
|
|
|
|
|
107
|
|
198
|
25
|
|
|
|
|
114
|
my (%params) = @_; |
199
|
25
|
|
|
|
|
371
|
my @bad_keys |
200
|
25
|
|
|
|
|
390
|
= grep { !Workflow::Config->is_valid_config_type($_) } keys %params; |
201
|
25
|
|
|
|
|
4259
|
if ( scalar @bad_keys ) { |
202
|
24
|
|
|
|
|
87
|
workflow_error "You tried to add configuration information to the ", |
203
|
23
|
|
|
|
|
80
|
"workflow factory with one or more bad keys: ", |
204
|
|
|
|
|
|
|
join( ', ', @bad_keys ), ". The following are the ", |
205
|
|
|
|
|
|
|
"keys you have to choose from: ", |
206
|
|
|
|
|
|
|
join( ', ', Workflow::Config->get_valid_config_types ), '.'; |
207
|
41
|
|
|
41
|
|
156
|
} |
208
|
|
|
|
|
|
|
} |
209
|
41
|
|
|
|
|
183
|
|
|
89
|
|
|
|
|
686
|
|
210
|
41
|
50
|
|
|
|
190
|
my ($item) = @_; |
211
|
0
|
|
|
|
|
0
|
return ( ref $item eq 'ARRAY' ) ? @{$item} : ($item); |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
######################################## |
215
|
|
|
|
|
|
|
# WORKFLOW |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
my ( $self, @all_workflow_config ) = @_; |
218
|
|
|
|
|
|
|
return unless ( scalar @all_workflow_config ); |
219
|
|
|
|
|
|
|
|
220
|
178
|
|
|
178
|
|
386
|
foreach my $workflow_config (@all_workflow_config) { |
221
|
178
|
100
|
|
|
|
690
|
next unless ( ref $workflow_config eq 'HASH' ); |
|
49
|
|
|
|
|
249
|
|
222
|
|
|
|
|
|
|
my $wf_type = $workflow_config->{type}; |
223
|
|
|
|
|
|
|
$self->{_workflow_config}{$wf_type} = $workflow_config; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# Create Workflow::State objects for each configured state. |
226
|
|
|
|
|
|
|
# When we instantiate a new workflow we pass these objects |
227
|
|
|
|
|
|
|
|
228
|
58
|
|
|
58
|
|
141
|
foreach my $state_conf ( @{ $workflow_config->{state} } ) { |
229
|
58
|
50
|
|
|
|
168
|
|
230
|
|
|
|
|
|
|
# Add the workflow type to the state conf. |
231
|
58
|
|
|
|
|
125
|
$state_conf->{type} = $wf_type; |
232
|
58
|
100
|
|
|
|
172
|
my $wf_state = Workflow::State->new( $state_conf, $self ); |
233
|
42
|
|
|
|
|
95
|
|
234
|
42
|
|
|
|
|
144
|
push @{ $self->{_workflow_state}{$wf_type} }, $wf_state; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
my $wf_class = $workflow_config->{class}; |
238
|
|
|
|
|
|
|
if ( $wf_class ) { |
239
|
42
|
|
|
|
|
60
|
$self->_load_class( $wf_class, |
|
42
|
|
|
|
|
99
|
|
240
|
|
|
|
|
|
|
q{Cannot require workflow class '%s': %s} ); |
241
|
|
|
|
|
|
|
} |
242
|
138
|
|
|
|
|
233
|
$self->_load_observers($workflow_config); |
243
|
138
|
|
|
|
|
626
|
|
244
|
|
|
|
|
|
|
$self->log->info( "Added all workflow states..." ); |
245
|
138
|
|
|
|
|
163
|
} |
|
138
|
|
|
|
|
376
|
|
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
return; |
248
|
42
|
|
|
|
|
93
|
} |
249
|
42
|
100
|
|
|
|
101
|
|
250
|
1
|
|
|
|
|
11
|
# Load all the observers so they're available when we instantiate the |
251
|
|
|
|
|
|
|
# workflow |
252
|
|
|
|
|
|
|
|
253
|
42
|
|
|
|
|
131
|
my ( $self, $workflow_config ) = @_; |
254
|
|
|
|
|
|
|
my $wf_type = $workflow_config->{type}; |
255
|
41
|
|
|
|
|
136
|
my $observer_specs = $workflow_config->{observer} || []; |
256
|
|
|
|
|
|
|
my @observers = (); |
257
|
|
|
|
|
|
|
foreach my $observer_info ( @{$observer_specs} ) { |
258
|
57
|
|
|
|
|
10786
|
if ( my $observer_class = $observer_info->{class} ) { |
259
|
|
|
|
|
|
|
$self->_load_class( $observer_class, |
260
|
|
|
|
|
|
|
"Cannot require observer '%s' to watch observer " |
261
|
|
|
|
|
|
|
. "of type '$wf_type': %s" ); |
262
|
|
|
|
|
|
|
push @observers, sub { $observer_class->update(@_) }; |
263
|
|
|
|
|
|
|
} elsif ( my $observer_sub = $observer_info->{sub} ) { |
264
|
|
|
|
|
|
|
my ( $observer_class, $observer_sub ) |
265
|
42
|
|
|
42
|
|
77
|
= $observer_sub =~ /^(.*)::(.*)$/; |
266
|
42
|
|
|
|
|
75
|
$self->_load_class( $observer_class, |
267
|
42
|
|
100
|
|
|
168
|
"Cannot require observer '%s' with sub '$observer_sub' to " |
268
|
42
|
|
|
|
|
75
|
. "watch observer of type '$wf_type': %s" ); |
269
|
42
|
|
|
|
|
51
|
my $o_sub_name = $observer_class . '::' . $observer_sub; |
|
42
|
|
|
|
|
95
|
|
270
|
3
|
100
|
|
|
|
14
|
if (exists &$o_sub_name) { |
|
|
50
|
|
|
|
|
|
271
|
1
|
|
|
|
|
5
|
no strict 'refs'; |
272
|
|
|
|
|
|
|
push @observers, \&{ $o_sub_name }; |
273
|
|
|
|
|
|
|
} else { |
274
|
1
|
|
|
9
|
|
7
|
my $error = 'subroutine not found'; |
|
9
|
|
|
|
|
93
|
|
275
|
|
|
|
|
|
|
$self->log->error( "Error loading subroutine '$observer_sub' in ", |
276
|
2
|
|
|
|
|
15
|
"class '$observer_class': $error" ); |
277
|
|
|
|
|
|
|
workflow_error $error; |
278
|
2
|
|
|
|
|
12
|
} |
279
|
|
|
|
|
|
|
} else { |
280
|
|
|
|
|
|
|
workflow_error "Cannot add observer to '$wf_type': you must ", |
281
|
2
|
|
|
|
|
8
|
"have either 'class' or 'sub' defined. (See ", |
282
|
2
|
100
|
|
|
|
15
|
"Workflow::Factory docs for details.)"; |
283
|
20
|
|
|
20
|
|
164
|
} |
|
20
|
|
|
|
|
40
|
|
|
20
|
|
|
|
|
32415
|
|
284
|
1
|
|
|
|
|
2
|
} |
|
1
|
|
|
|
|
4
|
|
285
|
|
|
|
|
|
|
|
286
|
1
|
|
|
|
|
3
|
my $observers_num = scalar @observers; |
287
|
1
|
|
|
|
|
4
|
|
288
|
|
|
|
|
|
|
if (@observers) { |
289
|
1
|
|
|
|
|
311
|
$self->{_workflow_observers}{$wf_type} = \@observers; |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
$self->log->info( |
292
|
0
|
|
|
|
|
0
|
sub { "Added $observers_num to '$wf_type': " . |
293
|
|
|
|
|
|
|
join( ', ', @observers ) } ); |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
} else { |
296
|
|
|
|
|
|
|
$self->{_workflow_observers}{$wf_type} = undef; |
297
|
|
|
|
|
|
|
|
298
|
41
|
|
|
|
|
69
|
$self->log->info( "No observers added to '$wf_type'" ); |
299
|
|
|
|
|
|
|
} |
300
|
41
|
100
|
|
|
|
80
|
|
301
|
1
|
|
|
|
|
2
|
return $observers_num; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
1
|
|
|
1
|
|
24
|
my ( $self, $class_to_load, $msg ) = @_; |
305
|
1
|
|
|
|
|
4
|
eval "require $class_to_load"; |
306
|
|
|
|
|
|
|
if ($EVAL_ERROR) { |
307
|
|
|
|
|
|
|
my $full_msg = sprintf $msg, $class_to_load, $EVAL_ERROR; |
308
|
40
|
|
|
|
|
87
|
$self->log->error($full_msg); |
309
|
|
|
|
|
|
|
workflow_error $full_msg; |
310
|
40
|
|
|
|
|
105
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
} |
313
|
41
|
|
|
|
|
10976
|
|
314
|
|
|
|
|
|
|
my ( $self, $wf_type, $context, $wf_class ) = @_; |
315
|
|
|
|
|
|
|
my $wf_config = $self->_get_workflow_config($wf_type); |
316
|
|
|
|
|
|
|
|
317
|
4
|
|
|
4
|
|
6
|
unless ($wf_config) { |
318
|
4
|
|
|
|
|
175
|
workflow_error "No workflow of type '$wf_type' available"; |
319
|
4
|
50
|
|
|
|
493
|
} |
320
|
0
|
|
|
|
|
0
|
|
321
|
0
|
|
|
|
|
0
|
$wf_class = $wf_config->{class} || 'Workflow' unless ($wf_class); |
322
|
0
|
|
|
|
|
0
|
my $wf |
323
|
|
|
|
|
|
|
= $wf_class->new( undef, |
324
|
|
|
|
|
|
|
$wf_config->{initial_state} || $DEFAULT_INITIAL_STATE, |
325
|
|
|
|
|
|
|
$wf_config, $self->{_workflow_state}{$wf_type}, $self ); |
326
|
|
|
|
|
|
|
$wf->context( $context || Workflow::Context->new ); |
327
|
|
|
|
|
|
|
$wf->last_update( DateTime->now( time_zone => $wf->time_zone() ) ); |
328
|
23
|
|
|
23
|
1
|
13254
|
$self->log->info( "Instantiated workflow object properly, persisting..." ); |
329
|
23
|
|
|
|
|
82
|
my $persister = $self->get_persister( $wf_config->{persister} ); |
330
|
|
|
|
|
|
|
my $id = $persister->create_workflow($wf); |
331
|
23
|
100
|
|
|
|
68
|
$wf->id($id); |
332
|
2
|
|
|
|
|
10
|
$self->log->info("Persisted workflow with ID '$id'; creating history..."); |
333
|
|
|
|
|
|
|
$persister->create_history( |
334
|
|
|
|
|
|
|
$wf, |
335
|
21
|
50
|
100
|
|
|
128
|
Workflow::History->new( |
336
|
|
|
|
|
|
|
{ workflow_id => $id, |
337
|
|
|
|
|
|
|
action => $persister->get_create_action($wf), |
338
|
|
|
|
|
|
|
description => $persister->get_create_description($wf), |
339
|
21
|
|
33
|
|
|
279
|
user => $persister->get_create_user($wf), |
340
|
21
|
|
33
|
|
|
300
|
state => $wf->state, |
341
|
21
|
|
|
|
|
76
|
date => DateTime->now( time_zone => $wf->time_zone() ), |
342
|
21
|
|
|
|
|
90
|
time_zone => $wf->time_zone(), |
343
|
21
|
|
|
|
|
5722
|
} |
344
|
21
|
|
|
|
|
100
|
) |
345
|
21
|
|
|
|
|
266
|
); |
346
|
21
|
|
|
|
|
110
|
$self->log->info( "Created history object ok" ); |
347
|
21
|
|
|
|
|
5581
|
|
348
|
|
|
|
|
|
|
$self->_commit_transaction($wf); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
my $state = $wf->_get_workflow_state(); |
351
|
|
|
|
|
|
|
if ( $state->autorun ) { |
352
|
|
|
|
|
|
|
my $state_name = $state->state; |
353
|
|
|
|
|
|
|
$self->log->info( "State '$state_name' marked to be run ", |
354
|
|
|
|
|
|
|
"automatically; executing that state/action..." ); |
355
|
|
|
|
|
|
|
$wf->_auto_execute_state($state); |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
$self->associate_observers_with_workflow($wf); |
359
|
|
|
|
|
|
|
$wf->notify_observers('create'); |
360
|
21
|
|
|
|
|
271
|
|
361
|
|
|
|
|
|
|
return $wf; |
362
|
21
|
|
|
|
|
5422
|
} |
363
|
|
|
|
|
|
|
|
364
|
21
|
|
|
|
|
111
|
my ( $self, $wf_type, $wf_id, $context, $wf_class ) = @_; |
365
|
21
|
50
|
|
|
|
128
|
my $wf_config = $self->_get_workflow_config($wf_type); |
366
|
0
|
|
|
|
|
0
|
|
367
|
0
|
|
|
|
|
0
|
unless ($wf_config) { |
368
|
|
|
|
|
|
|
workflow_error "No workflow of type '$wf_type' available"; |
369
|
0
|
|
|
|
|
0
|
} |
370
|
|
|
|
|
|
|
my $persister = $self->get_persister( $wf_config->{persister} ); |
371
|
|
|
|
|
|
|
my $wf_info = $persister->fetch_workflow($wf_id); |
372
|
21
|
|
|
|
|
126
|
$wf_class = $wf_config->{class} || 'Workflow' unless ($wf_class); |
373
|
21
|
|
|
|
|
89
|
|
374
|
|
|
|
|
|
|
return unless ($wf_info); |
375
|
21
|
|
|
|
|
231
|
|
376
|
|
|
|
|
|
|
$wf_info->{last_update} ||= ''; |
377
|
|
|
|
|
|
|
$self->log->debug( |
378
|
|
|
|
|
|
|
"Fetched data for workflow '$wf_id' ok: ", |
379
|
8
|
|
|
8
|
1
|
28343
|
"[State: $wf_info->{state}] ", |
380
|
8
|
|
|
|
|
21
|
"[Last update: $wf_info->{last_update}]" |
381
|
|
|
|
|
|
|
); |
382
|
8
|
50
|
|
|
|
22
|
my $wf = $wf_class->new( $wf_id, $wf_info->{state}, $wf_config, |
383
|
0
|
|
|
|
|
0
|
$self->{_workflow_state}{$wf_type}, $self ); |
384
|
|
|
|
|
|
|
|
385
|
8
|
|
|
|
|
25
|
$wf->context( $wf_info->{context} || Workflow::Context->new ); #if ( not $wf->context() ); |
386
|
8
|
|
|
|
|
24
|
$wf->last_update( $wf_info->{last_update} ); |
387
|
8
|
50
|
100
|
|
|
2441
|
|
388
|
|
|
|
|
|
|
$persister->fetch_extra_workflow_data($wf); |
389
|
8
|
100
|
|
|
|
23
|
|
390
|
|
|
|
|
|
|
$self->associate_observers_with_workflow($wf); |
391
|
6
|
|
50
|
|
|
19
|
$wf->notify_observers('fetch'); |
392
|
6
|
|
|
|
|
42
|
|
393
|
|
|
|
|
|
|
return $wf; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
my ( $self, $wf ) = @_; |
397
|
|
|
|
|
|
|
my $observers = $self->{_workflow_observers}{ $wf->type }; |
398
|
6
|
|
|
|
|
2098
|
return unless ( ref $observers eq 'ARRAY' ); |
399
|
|
|
|
|
|
|
$wf->add_observer($_) for ( @{$observers} ); |
400
|
6
|
|
66
|
|
|
37
|
} |
401
|
6
|
|
|
|
|
17
|
|
402
|
|
|
|
|
|
|
my $self = shift; |
403
|
6
|
|
|
|
|
34
|
my $wf_type = shift; |
404
|
|
|
|
|
|
|
|
405
|
6
|
|
|
|
|
48
|
if ( ref( $self->config_callback ) eq 'CODE' ) { |
406
|
6
|
|
|
|
|
25
|
my $args = &{ $self->config_callback }($wf_type); |
407
|
|
|
|
|
|
|
$self->add_config_from_file( %{$args} ) if $args && %{$args}; |
408
|
6
|
|
|
|
|
37
|
} |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
my ( $self, $wf_type ) = @_; |
412
|
27
|
|
|
27
|
1
|
58
|
$self->_initialize_workflow_config($wf_type) |
413
|
27
|
|
|
|
|
88
|
unless $self->{_workflow_config}{$wf_type}; |
414
|
27
|
100
|
|
|
|
354
|
return $self->{_workflow_config}{$wf_type}; |
415
|
5
|
|
|
|
|
6
|
} |
|
5
|
|
|
|
|
19
|
|
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
my ( $self, $wf ) = @_; |
418
|
|
|
|
|
|
|
my $wf_config = $self->_get_workflow_config( $wf->type ); |
419
|
3
|
|
|
3
|
|
5
|
my $persister = $self->get_persister( $wf_config->{persister} ); |
420
|
3
|
|
|
|
|
4
|
my $id = $persister->create_workflow($wf); |
421
|
|
|
|
|
|
|
$wf->id($id); |
422
|
3
|
100
|
|
|
|
9
|
return $wf; |
423
|
2
|
|
|
|
|
23
|
|
|
2
|
|
|
|
|
4
|
|
424
|
2
|
100
|
66
|
|
|
29
|
} |
|
1
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
8
|
|
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
my ( $self, $wf ) = @_; |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
my $old_update = $wf->last_update; |
429
|
163
|
|
|
163
|
|
1327
|
$wf->last_update( DateTime->now( time_zone => $wf->time_zone() ) ); |
430
|
|
|
|
|
|
|
|
431
|
163
|
100
|
|
|
|
504
|
my $wf_config = $self->_get_workflow_config( $wf->type ); |
432
|
163
|
|
|
|
|
330
|
my $persister = $self->get_persister( $wf_config->{persister} ); |
433
|
|
|
|
|
|
|
eval { |
434
|
|
|
|
|
|
|
$persister->update_workflow($wf); |
435
|
|
|
|
|
|
|
$self->log->info( "Workflow '", $wf->id, "' updated ok" ); |
436
|
0
|
|
|
0
|
|
0
|
my @unsaved = $wf->get_unsaved_history; |
437
|
0
|
|
|
|
|
0
|
foreach my $h (@unsaved) { |
438
|
0
|
|
|
|
|
0
|
$h->set_new_state( $wf->state ); |
439
|
0
|
|
|
|
|
0
|
} |
440
|
0
|
|
|
|
|
0
|
$persister->create_history( $wf, @unsaved ); |
441
|
0
|
|
|
|
|
0
|
$self->log->info( "Created necessary history objects ok" ); |
442
|
|
|
|
|
|
|
}; |
443
|
|
|
|
|
|
|
if ($EVAL_ERROR) { |
444
|
|
|
|
|
|
|
$wf->last_update($old_update); |
445
|
|
|
|
|
|
|
croak $EVAL_ERROR; |
446
|
54
|
|
|
54
|
1
|
521
|
} |
447
|
|
|
|
|
|
|
|
448
|
54
|
|
|
|
|
130
|
$wf->notify_observers('save'); |
449
|
54
|
|
|
|
|
451
|
|
450
|
|
|
|
|
|
|
return $wf; |
451
|
54
|
|
|
|
|
164
|
} |
452
|
54
|
|
|
|
|
146
|
|
453
|
54
|
|
|
|
|
69
|
# Only implemented for DBI. Don't know if this could be implemented |
454
|
54
|
|
|
|
|
175
|
# for other persisters. |
455
|
54
|
|
|
|
|
8013
|
my ( $self, $wf ) = @_; |
456
|
54
|
|
|
|
|
6650
|
|
457
|
54
|
|
|
|
|
112
|
my $wf_config = $self->_get_workflow_config( $wf->type ); |
458
|
9
|
|
|
|
|
29
|
my $persister = $self->get_persister( $wf_config->{persister} ); |
459
|
|
|
|
|
|
|
$persister->commit_transaction(); |
460
|
54
|
|
|
|
|
264
|
$self->log->debug('Committed transaction.'); |
461
|
54
|
|
|
|
|
133
|
return; |
462
|
|
|
|
|
|
|
} |
463
|
54
|
50
|
|
|
|
5998
|
|
464
|
0
|
|
|
|
|
0
|
my ( $self, $wf ) = @_; |
465
|
0
|
|
|
|
|
0
|
|
466
|
|
|
|
|
|
|
my $wf_config = $self->_get_workflow_config( $wf->type ); |
467
|
|
|
|
|
|
|
my $persister = $self->get_persister( $wf_config->{persister} ); |
468
|
54
|
|
|
|
|
160
|
$persister->rollback_transaction(); |
469
|
|
|
|
|
|
|
$self->log->debug('Rolled back transaction.'); |
470
|
54
|
|
|
|
|
644
|
return; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
my ( $self, $wf ) = @_; |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
$self->log->debug( "Trying to fetch history for workflow ", $wf->id ); |
476
|
74
|
|
|
74
|
|
481
|
my $wf_config = $self->_get_workflow_config( $wf->type ); |
477
|
|
|
|
|
|
|
my $persister = $self->get_persister( $wf_config->{persister} ); |
478
|
74
|
|
|
|
|
175
|
return $persister->fetch_history($wf); |
479
|
74
|
|
|
|
|
217
|
} |
480
|
74
|
|
|
|
|
211
|
|
481
|
74
|
|
|
|
|
684
|
######################################## |
482
|
74
|
|
|
|
|
11110
|
# ACTIONS |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
my ( $self, @all_action_config ) = @_; |
485
|
|
|
|
|
|
|
|
486
|
0
|
|
|
0
|
|
0
|
return unless ( scalar @all_action_config ); |
487
|
|
|
|
|
|
|
|
488
|
0
|
|
|
|
|
0
|
foreach my $actions (@all_action_config) { |
489
|
0
|
|
|
|
|
0
|
next unless ( ref $actions eq 'HASH' ); |
490
|
0
|
|
|
|
|
0
|
|
491
|
0
|
|
|
|
|
0
|
# TODO Handle optional type. |
492
|
0
|
|
|
|
|
0
|
# Should we check here to see if this matches an existing |
493
|
|
|
|
|
|
|
# workflow type? Maybe do a type check at the end of the config |
494
|
|
|
|
|
|
|
# process? |
495
|
|
|
|
|
|
|
my $type = exists $actions->{type} ? $actions->{type} : 'default'; |
496
|
4
|
|
|
4
|
1
|
53
|
|
497
|
|
|
|
|
|
|
my $action; |
498
|
4
|
|
|
|
|
15
|
if ( exists $actions->{action} ) { |
499
|
4
|
|
|
|
|
1236
|
$action = $actions->{action}; |
500
|
4
|
|
|
|
|
12
|
} else { |
501
|
4
|
|
|
|
|
15
|
push @{$action}, $actions; |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
foreach my $action_config ( @{$action} ) { |
505
|
|
|
|
|
|
|
my $name = $action_config->{name}; |
506
|
|
|
|
|
|
|
$self->log->debug( |
507
|
|
|
|
|
|
|
"Adding configuration for type '$type', action '$name'"); |
508
|
52
|
|
|
52
|
|
154
|
$self->{_action_config}{$type}{$name} = $action_config; |
509
|
|
|
|
|
|
|
my $action_class = $action_config->{class}; |
510
|
52
|
100
|
|
|
|
140
|
unless ($action_class) { |
511
|
|
|
|
|
|
|
configuration_error |
512
|
51
|
|
|
|
|
104
|
"Action '$name' must be associated with a ", |
513
|
51
|
100
|
|
|
|
161
|
"class using the 'class' attribute."; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
$self->log->debug( |
516
|
|
|
|
|
|
|
"Trying to include action class '$action_class'..."); |
517
|
|
|
|
|
|
|
eval "require $action_class"; |
518
|
|
|
|
|
|
|
if ($EVAL_ERROR) { |
519
|
33
|
100
|
|
|
|
112
|
my $msg = $EVAL_ERROR; |
520
|
|
|
|
|
|
|
$msg =~ s/\\n/ /g; |
521
|
33
|
|
|
|
|
54
|
configuration_error |
522
|
33
|
100
|
|
|
|
99
|
"Cannot include action class '$action_class': $msg"; |
523
|
31
|
|
|
|
|
60
|
} |
524
|
|
|
|
|
|
|
$self->log->debug( |
525
|
2
|
|
|
|
|
3
|
"Included action '$name' class '$action_class' ok"); |
|
2
|
|
|
|
|
4
|
|
526
|
|
|
|
|
|
|
if ($self->_validate_action_config) { |
527
|
|
|
|
|
|
|
my $validate_name = $action_class . '::validate_config'; |
528
|
33
|
|
|
|
|
47
|
if (exists &$validate_name) { |
|
33
|
|
|
|
|
135
|
|
529
|
139
|
|
|
|
|
247
|
no strict 'refs'; |
530
|
139
|
|
|
|
|
350
|
$self->log->debug( |
531
|
|
|
|
|
|
|
"Validating configuration for action '$name'"); |
532
|
139
|
|
|
|
|
35666
|
$validate_name->($action_config); |
533
|
139
|
|
|
|
|
319
|
} |
534
|
139
|
50
|
|
|
|
292
|
} |
535
|
0
|
|
|
|
|
0
|
} # End action for. |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
my ( $self, $wf, $action_name ) = @_; |
540
|
139
|
|
|
|
|
350
|
my $config = $self->{_action_config}{ $wf->type }{$action_name}; |
541
|
139
|
|
|
|
|
41207
|
$config = $self->{_action_config}{default}{$action_name} |
542
|
139
|
50
|
|
|
|
20000
|
unless ($config and %{$config}); |
543
|
0
|
|
|
|
|
0
|
|
544
|
0
|
|
|
|
|
0
|
unless ($config) { |
545
|
0
|
|
|
|
|
0
|
workflow_error "No action with name '$action_name' available"; |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
return $config; |
548
|
|
|
|
|
|
|
} |
549
|
139
|
|
|
|
|
439
|
|
550
|
139
|
100
|
|
|
|
36792
|
my ( $self, $wf, $action_name ) = @_; |
551
|
3
|
|
|
|
|
8
|
my $config = $self->get_action_config( $wf, $action_name );; |
552
|
3
|
100
|
|
|
|
12
|
my $action_class = $config->{class}; |
553
|
20
|
|
|
20
|
|
169
|
return $action_class->new( $wf, $config ); |
|
20
|
|
|
|
|
49
|
|
|
20
|
|
|
|
|
29735
|
|
554
|
2
|
|
|
|
|
6
|
} |
555
|
|
|
|
|
|
|
|
556
|
2
|
|
|
|
|
551
|
######################################## |
557
|
|
|
|
|
|
|
# PERSISTERS |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
my ( $self, @all_persister_config ) = @_; |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
return unless ( scalar @all_persister_config ); |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
foreach my $persister_config (@all_persister_config) { |
564
|
60
|
|
|
60
|
1
|
616
|
next unless ( ref $persister_config eq 'HASH' ); |
565
|
60
|
|
|
|
|
156
|
my $name = $persister_config->{name}; |
566
|
|
|
|
|
|
|
$self->log->debug( "Adding configuration for persister '$name'" ); |
567
|
60
|
100
|
66
|
|
|
644
|
$self->{_persister_config}{$name} = $persister_config; |
|
5
|
|
|
|
|
18
|
|
568
|
|
|
|
|
|
|
my $persister_class = $persister_config->{class}; |
569
|
60
|
50
|
|
|
|
116
|
unless ($persister_class) { |
570
|
0
|
|
|
|
|
0
|
configuration_error "You must specify a 'class' in persister ", |
571
|
|
|
|
|
|
|
"'$name' configuration"; |
572
|
60
|
|
|
|
|
97
|
} |
573
|
|
|
|
|
|
|
$self->log->debug( |
574
|
|
|
|
|
|
|
"Trying to include persister class '$persister_class'..."); |
575
|
|
|
|
|
|
|
eval "require $persister_class"; |
576
|
0
|
|
|
0
|
1
|
0
|
if ($EVAL_ERROR) { |
577
|
0
|
|
|
|
|
0
|
configuration_error "Cannot include persister class ", |
578
|
0
|
|
|
|
|
0
|
"'$persister_class': $EVAL_ERROR"; |
579
|
0
|
|
|
|
|
0
|
} |
580
|
|
|
|
|
|
|
$self->log->debug( |
581
|
|
|
|
|
|
|
"Included persister '$name' class '$persister_class' ", |
582
|
|
|
|
|
|
|
"ok; now try to instantiate persister..." ); |
583
|
|
|
|
|
|
|
my $persister = eval { $persister_class->new($persister_config) }; |
584
|
|
|
|
|
|
|
if ($EVAL_ERROR) { |
585
|
|
|
|
|
|
|
configuration_error "Failed to create instance of persister ", |
586
|
41
|
|
|
41
|
|
96
|
"'$name' of class '$persister_class': $EVAL_ERROR"; |
587
|
|
|
|
|
|
|
} |
588
|
41
|
100
|
|
|
|
116
|
$self->{_persister}{$name} = $persister; |
589
|
|
|
|
|
|
|
$self->log->debug( "Instantiated persister '$name' ok" ); |
590
|
25
|
|
|
|
|
46
|
} |
591
|
27
|
100
|
|
|
|
420
|
} |
592
|
16
|
|
|
|
|
32
|
|
593
|
16
|
|
|
|
|
91
|
my ( $self, $persister_name ) = @_; |
594
|
16
|
|
|
|
|
4052
|
my $persister = $self->{_persister}{$persister_name}; |
595
|
16
|
|
|
|
|
39
|
unless ($persister) { |
596
|
16
|
50
|
|
|
|
50
|
workflow_error "No persister with name '$persister_name' available"; |
597
|
0
|
|
|
|
|
0
|
} |
598
|
|
|
|
|
|
|
return $persister; |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
16
|
|
|
|
|
50
|
my $self = shift; |
602
|
16
|
|
|
|
|
4817
|
my @persisters = sort keys %{ $self->{_persister} }; |
603
|
16
|
50
|
|
|
|
86
|
|
604
|
0
|
|
|
|
|
0
|
return @persisters; |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
my $self = shift; |
608
|
16
|
|
|
|
|
79
|
|
609
|
|
|
|
|
|
|
my ($type) = @_; |
610
|
16
|
|
|
|
|
4980
|
my $wf_config = $self->_get_workflow_config($type); |
|
16
|
|
|
|
|
150
|
|
611
|
16
|
50
|
|
|
|
79
|
if ( not $wf_config ) { |
612
|
0
|
|
|
|
|
0
|
workflow_error "no workflow of type '$type' available"; |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
my $persister = $self->get_persister( $wf_config->{'persister'} ); |
615
|
16
|
|
|
|
|
52
|
|
616
|
16
|
|
|
|
|
128
|
return $persister; |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
######################################## |
620
|
|
|
|
|
|
|
# CONDITIONS |
621
|
188
|
|
|
188
|
1
|
1259
|
|
622
|
188
|
|
|
|
|
371
|
my ( $self, @all_condition_config ) = @_; |
623
|
188
|
50
|
|
|
|
347
|
|
624
|
0
|
|
|
|
|
0
|
return unless ( scalar @all_condition_config ); |
625
|
|
|
|
|
|
|
|
626
|
188
|
|
|
|
|
281
|
foreach my $conditions (@all_condition_config) { |
627
|
|
|
|
|
|
|
next unless ( ref $conditions eq 'HASH' ); |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
my $type |
630
|
0
|
|
|
0
|
1
|
0
|
= exists $conditions->{type} ? $conditions->{type} : 'default'; |
631
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
632
|
|
|
|
|
|
|
my $c; |
633
|
0
|
|
|
|
|
0
|
if ( exists $conditions->{condition} ) { |
634
|
|
|
|
|
|
|
$c = $conditions->{condition}; |
635
|
|
|
|
|
|
|
} else { |
636
|
|
|
|
|
|
|
push @{$c}, $conditions; |
637
|
0
|
|
|
0
|
1
|
0
|
} |
638
|
|
|
|
|
|
|
|
639
|
0
|
|
|
|
|
0
|
foreach my $condition_config ( @{$c} ) { |
640
|
0
|
|
|
|
|
0
|
my $name = $condition_config->{name}; |
641
|
0
|
0
|
|
|
|
0
|
$self->log->debug( "Adding configuration for condition '$name'" ); |
642
|
0
|
|
|
|
|
0
|
$self->{_condition_config}{$type}{$name} = $condition_config; |
643
|
|
|
|
|
|
|
my $condition_class = $condition_config->{class}; |
644
|
0
|
|
|
|
|
0
|
unless ($condition_class) { |
645
|
|
|
|
|
|
|
configuration_error "Condition '$name' must be associated ", |
646
|
0
|
|
|
|
|
0
|
"with a class using the 'class' attribute"; |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
$self->log->debug( |
649
|
|
|
|
|
|
|
"Trying to include condition class '$condition_class'"); |
650
|
|
|
|
|
|
|
eval "require $condition_class"; |
651
|
|
|
|
|
|
|
if ($EVAL_ERROR) { |
652
|
|
|
|
|
|
|
configuration_error "Cannot include condition class ", |
653
|
51
|
|
|
51
|
|
127
|
"'$condition_class': $EVAL_ERROR"; |
654
|
|
|
|
|
|
|
} |
655
|
51
|
100
|
|
|
|
153
|
$self->log->debug( |
656
|
|
|
|
|
|
|
"Included condition '$name' class '$condition_class' ", |
657
|
50
|
|
|
|
|
94
|
"ok; now try to instantiate condition..." ); |
658
|
51
|
100
|
|
|
|
509
|
my $condition = eval { $condition_class->new($condition_config) }; |
659
|
|
|
|
|
|
|
if ($EVAL_ERROR) { |
660
|
|
|
|
|
|
|
configuration_error |
661
|
27
|
100
|
|
|
|
103
|
"Cannot create condition '$name': $EVAL_ERROR"; |
662
|
|
|
|
|
|
|
} |
663
|
27
|
|
|
|
|
42
|
$self->{_conditions}{$type}{$name} = $condition; |
664
|
27
|
100
|
|
|
|
74
|
$self->log->debug( "Instantiated condition '$name' ok" ); |
665
|
25
|
|
|
|
|
50
|
} |
666
|
|
|
|
|
|
|
} |
667
|
2
|
|
|
|
|
2
|
} |
|
2
|
|
|
|
|
4
|
|
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
my ( $self, $name, $type ) = @_; |
670
|
27
|
|
|
|
|
42
|
|
|
27
|
|
|
|
|
49
|
|
671
|
41
|
|
|
|
|
734
|
my $condition; |
672
|
41
|
|
|
|
|
150
|
|
673
|
41
|
|
|
|
|
8347
|
if ( defined $type ) { |
674
|
41
|
|
|
|
|
89
|
$condition = $self->{_conditions}{$type}{$name}; |
675
|
41
|
50
|
|
|
|
109
|
} |
676
|
0
|
|
|
|
|
0
|
|
677
|
|
|
|
|
|
|
# This catches cases where type isn't defined and cases |
678
|
|
|
|
|
|
|
# where the condition was defined as the default rather than |
679
|
|
|
|
|
|
|
# the current Workflow type. |
680
|
41
|
|
|
|
|
109
|
if ( not defined $condition ) { |
681
|
41
|
|
|
|
|
10613
|
$condition = $self->{_conditions}{'default'}{$name}; |
682
|
41
|
50
|
|
|
|
6294
|
} |
683
|
0
|
|
|
|
|
0
|
|
684
|
|
|
|
|
|
|
if ( not defined $condition |
685
|
|
|
|
|
|
|
and $name =~ m/ \A ! /msx ) { |
686
|
|
|
|
|
|
|
my $negated = $name; |
687
|
41
|
|
|
|
|
145
|
$negated =~ s/ \A ! //gx; |
688
|
|
|
|
|
|
|
|
689
|
41
|
|
|
|
|
8887
|
if ( $self->get_condition( $negated, $type ) ) { |
|
41
|
|
|
|
|
356
|
|
690
|
41
|
50
|
|
|
|
96
|
$condition = Workflow::Condition::Negated->new( |
691
|
0
|
|
|
|
|
0
|
{ name => $name } |
692
|
|
|
|
|
|
|
); |
693
|
|
|
|
|
|
|
|
694
|
41
|
|
|
|
|
133
|
$type = 'default' unless defined $type; |
695
|
41
|
|
|
|
|
96
|
$self->{_conditions}{$type}{$name} = $condition; |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
unless ($condition) { |
700
|
|
|
|
|
|
|
workflow_error "No condition with name '$name' available"; |
701
|
232
|
|
|
232
|
1
|
3696
|
} |
702
|
|
|
|
|
|
|
return $condition; |
703
|
232
|
|
|
|
|
230
|
} |
704
|
|
|
|
|
|
|
|
705
|
232
|
100
|
|
|
|
365
|
######################################## |
706
|
231
|
|
|
|
|
510
|
# VALIDATORS |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
my ( $self, @all_validator_config ) = @_; |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
return unless (@all_validator_config); |
711
|
|
|
|
|
|
|
|
712
|
232
|
100
|
|
|
|
398
|
foreach my $validators (@all_validator_config) { |
713
|
175
|
|
|
|
|
302
|
next unless ( ref $validators eq 'HASH' ); |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
my $v; |
716
|
232
|
100
|
66
|
|
|
508
|
if ( exists $validators->{validator} ) { |
717
|
|
|
|
|
|
|
$v = $validators->{validator}; |
718
|
13
|
|
|
|
|
20
|
} else { |
719
|
13
|
|
|
|
|
38
|
push @{$v}, $validators; |
720
|
|
|
|
|
|
|
} |
721
|
13
|
50
|
|
|
|
32
|
|
722
|
13
|
|
|
|
|
86
|
for my $validator_config ( @{$v} ) { |
723
|
|
|
|
|
|
|
my $name = $validator_config->{name}; |
724
|
|
|
|
|
|
|
$self->log->debug( "Adding configuration for validator '$name'" ); |
725
|
|
|
|
|
|
|
$self->{_validator_config}{$name} = $validator_config; |
726
|
13
|
50
|
|
|
|
32
|
my $validator_class = $validator_config->{class}; |
727
|
13
|
|
|
|
|
34
|
unless ($validator_class) { |
728
|
|
|
|
|
|
|
configuration_error |
729
|
|
|
|
|
|
|
"Validator '$name' must be associated with ", |
730
|
|
|
|
|
|
|
"a class using the 'class' attribute."; |
731
|
232
|
50
|
|
|
|
379
|
} |
732
|
0
|
|
|
|
|
0
|
$self->log->debug( |
733
|
|
|
|
|
|
|
"Trying to include validator class '$validator_class'"); |
734
|
232
|
|
|
|
|
418
|
eval "require $validator_class"; |
735
|
|
|
|
|
|
|
if ($EVAL_ERROR) { |
736
|
|
|
|
|
|
|
workflow_error |
737
|
|
|
|
|
|
|
"Cannot include validator class '$validator_class': $EVAL_ERROR"; |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
$self->log->debug( |
740
|
|
|
|
|
|
|
"Included validator '$name' class '$validator_class' ", |
741
|
42
|
|
|
42
|
|
112
|
" ok; now try to instantiate validator..." |
742
|
|
|
|
|
|
|
); |
743
|
42
|
100
|
|
|
|
107
|
my $validator = eval { $validator_class->new($validator_config) }; |
744
|
|
|
|
|
|
|
if ($EVAL_ERROR) { |
745
|
37
|
|
|
|
|
72
|
workflow_error "Cannot create validator '$name': $EVAL_ERROR"; |
746
|
37
|
100
|
|
|
|
127
|
} |
747
|
|
|
|
|
|
|
$self->{_validators}{$name} = $validator; |
748
|
13
|
|
|
|
|
25
|
$self->log->debug( "Instantiated validator '$name' ok" ); |
749
|
13
|
100
|
|
|
|
46
|
} |
750
|
12
|
|
|
|
|
29
|
} |
751
|
|
|
|
|
|
|
} |
752
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
753
|
|
|
|
|
|
|
my ( $self, $name ) = @_; |
754
|
|
|
|
|
|
|
unless ( $self->{_validators}{$name} ) { |
755
|
13
|
|
|
|
|
23
|
workflow_error "No validator with name '$name' available"; |
|
13
|
|
|
|
|
30
|
|
756
|
13
|
|
|
|
|
30
|
} |
757
|
13
|
|
|
|
|
51
|
return $self->{_validators}{$name}; |
758
|
13
|
|
|
|
|
3743
|
} |
759
|
13
|
|
|
|
|
42
|
|
760
|
13
|
50
|
|
|
|
43
|
my $self = shift; |
761
|
0
|
|
|
|
|
0
|
my @validators = sort keys %{ $self->{_validators} }; |
762
|
|
|
|
|
|
|
return @validators; |
763
|
|
|
|
|
|
|
} |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
return $VALIDATE_ACTION_CONFIG; |
766
|
13
|
|
|
|
|
50
|
} |
767
|
13
|
|
|
|
|
4485
|
|
768
|
13
|
50
|
|
|
|
80
|
1; |
769
|
0
|
|
|
|
|
0
|
|
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=pod |
772
|
|
|
|
|
|
|
|
773
|
13
|
|
|
|
|
76
|
=head1 NAME |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
Workflow::Factory - Generates new workflow and supporting objects |
776
|
13
|
|
|
|
|
5325
|
|
|
13
|
|
|
|
|
105
|
|
777
|
13
|
50
|
|
|
|
55
|
=head1 VERSION |
778
|
0
|
|
|
|
|
0
|
|
779
|
|
|
|
|
|
|
This documentation describes version 1.61 of this package |
780
|
13
|
|
|
|
|
121
|
|
781
|
13
|
|
|
|
|
47
|
=head1 SYNOPSIS |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
# Import the singleton for easy access |
784
|
|
|
|
|
|
|
use Workflow::Factory qw( FACTORY ); |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
# Add XML configurations to the factory |
787
|
13
|
|
|
13
|
1
|
211
|
FACTORY->add_config_from_file( workflow => 'workflow.xml', |
788
|
13
|
50
|
|
|
|
57
|
action => [ 'myactions.xml', 'otheractions.xml' ], |
789
|
0
|
|
|
|
|
0
|
validator => [ 'validator.xml', 'myvalidators.xml' ], |
790
|
|
|
|
|
|
|
condition => 'condition.xml', |
791
|
13
|
|
|
|
|
32
|
persister => 'persister.xml' ); |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
# Create a new workflow of type 'MyWorkflow' |
794
|
|
|
|
|
|
|
my $wf = FACTORY->create_workflow( 'MyWorkflow' ); |
795
|
0
|
|
|
0
|
1
|
0
|
|
796
|
0
|
|
|
|
|
0
|
# Fetch an existing workflow with ID '25' |
|
0
|
|
|
|
|
0
|
|
797
|
0
|
|
|
|
|
0
|
my $wf = FACTORY->fetch_workflow( 'MyWorkflow', 25 ); |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=head1 DESCRIPTION |
800
|
|
|
|
|
|
|
|
801
|
139
|
|
|
139
|
|
496
|
=head2 Public |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
The Workflow Factory is your primary interface to the workflow |
804
|
|
|
|
|
|
|
system. You give it the configuration files and/or data structures for |
805
|
|
|
|
|
|
|
the L<Workflow>, L<Workflow::Action>, L<Workflow::Condition>, |
806
|
|
|
|
|
|
|
L<Workflow::Persister>, and L<Workflow::Validator> objects and then |
807
|
|
|
|
|
|
|
you ask it for new and existing L<Workflow> objects. |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=head2 Internal |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
Developers using the workflow system should be familiar with how the |
812
|
|
|
|
|
|
|
factory processes configurations and how it makes the various |
813
|
|
|
|
|
|
|
components of the system are instantiated and stored in the factory. |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
=head1 METHODS |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=head2 Public Methods |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=head3 instance() |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
The factory is a singleton, this is how you get access to the |
822
|
|
|
|
|
|
|
instance. You can also just import the 'FACTORY' constant as in the |
823
|
|
|
|
|
|
|
L</SYNOPSIS>. |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=head3 create_workflow( $workflow_type, $context, $wf_class ) |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
Create a new workflow of type C<$workflow_type>. This will create a |
828
|
|
|
|
|
|
|
new record in whatever persistence mechanism you have associated with |
829
|
|
|
|
|
|
|
C<$workflow_type> and set the workflow to its initial state. |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
The C<$context> argument is optional, you can pass an exisiting instance |
832
|
|
|
|
|
|
|
of Workflow::Context to be reused. Otherwise a new instance is created. |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
The C<$wf_class> argument is optional. Pass it the name of a class to be |
835
|
|
|
|
|
|
|
used for the workflow to be created. By default, all workflows are of the |
836
|
|
|
|
|
|
|
I<Workflow> class. |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
Any observers you've associated with this workflow type will be |
839
|
|
|
|
|
|
|
attached to the returned workflow object. |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
This fires a 'create' event from the just-created workflow object. See |
842
|
|
|
|
|
|
|
C<WORKFLOWS ARE OBSERVABLE> in L<Workflow> for more. |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
Returns: newly created workflow object. |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
=head3 fetch_workflow( $workflow_type, $workflow_id, $context, $wf_class ) |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
Retrieve a workflow object of type C<$workflow_type> and ID |
849
|
|
|
|
|
|
|
C<$workflow_id>. (The C<$workflow_type> is necessary so we can fetch |
850
|
|
|
|
|
|
|
the workflow using the correct persister.) If a workflow with ID |
851
|
|
|
|
|
|
|
C<$workflow_id> is not found C<undef> is returned. |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
The C<$context> argument is optional, you can pass an exisiting instance |
854
|
|
|
|
|
|
|
of Workflow::Context to be reused. Otherwise a new instance is created. |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
The C<$wf_class> argument is optional. Pass it the name of a class to be |
857
|
|
|
|
|
|
|
used for the workflow to be created. By default, all workflows are of the |
858
|
|
|
|
|
|
|
I<Workflow> class. |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
Any observers you've associated with this workflow type will be |
861
|
|
|
|
|
|
|
attached to the returned workflow object. |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
This fires a 'fetch' event from the retrieved workflow object. See |
864
|
|
|
|
|
|
|
C<WORKFLOWS ARE OBSERVABLE> in L<Workflow> for more. |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
Throws exception if no workflow type C<$workflow_type> available. |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
Returns: L<Workflow> object |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=head3 add_config_from_file( %config_declarations ) |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
Pass in filenames for the various components you wish to initialize |
873
|
|
|
|
|
|
|
using the keys 'action', 'condition', 'persister', 'validator' and |
874
|
|
|
|
|
|
|
'workflow'. The value for each can be a single filename or an arrayref |
875
|
|
|
|
|
|
|
of filenames. |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
The system is familiar with the 'perl' and 'xml' configuration formats |
878
|
|
|
|
|
|
|
-- see the 'doc/configuration.txt' for what we expect as the format |
879
|
|
|
|
|
|
|
and will autodetect the types based on the file extension of each |
880
|
|
|
|
|
|
|
file. Just give your file the right extension and it will be read in |
881
|
|
|
|
|
|
|
properly. |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
You may also use your own custom configuration file format -- see |
884
|
|
|
|
|
|
|
C<SUBCLASSING> in L<Workflow::Config> for what you need to do. |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
You can also read it in yourself and add the resulting hash reference |
887
|
|
|
|
|
|
|
directly to the factory using C<add_config()>. However, you need to |
888
|
|
|
|
|
|
|
ensure the configurations are added in the proper order -- when you |
889
|
|
|
|
|
|
|
add an 'action' configuration and reference 'validator' objects, those |
890
|
|
|
|
|
|
|
objects should already be read in. A good order is: 'validator', |
891
|
|
|
|
|
|
|
'condition', 'action', 'workflow'. Then just pass the resulting hash |
892
|
|
|
|
|
|
|
references to C<add_config()> using the right type and the behavior |
893
|
|
|
|
|
|
|
should be exactly the same. |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
Returns: nothing; if we run into a problem parsing one of the files or |
896
|
|
|
|
|
|
|
creating the objects it requires we throw a L<Workflow::Exception>. |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=head3 add_config( %config_hashrefs ) |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
Similar to C<add_config_from_file()> -- the keys may be 'action', |
901
|
|
|
|
|
|
|
'condition', 'persister', 'validator' and/or 'workflow'. But the |
902
|
|
|
|
|
|
|
values are the actual configuration hashrefs instead of the files |
903
|
|
|
|
|
|
|
holding the configurations. |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
You normally will only need to call this if you are programmatically |
906
|
|
|
|
|
|
|
creating configurations (e.g., hot-deploying a validator class |
907
|
|
|
|
|
|
|
specified by a user) or using a custom configuration format and for |
908
|
|
|
|
|
|
|
some reason do not want to use the built-in mechanism in |
909
|
|
|
|
|
|
|
L<Workflow::Config> to read it for you. |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
Returns: nothing; if we encounter an error trying to create the |
912
|
|
|
|
|
|
|
objects referenced in a configuration we throw a |
913
|
|
|
|
|
|
|
L<Workflow::Exception>. |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=head3 get_persister_for_workflow_type |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=head3 get_persisters |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
#TODO |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
=head3 get_validators |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
#TODO |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
=head2 Internal Methods |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
#TODO |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
=head3 save_workflow( $workflow ) |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
Stores the state and current datetime of the C<$workflow> object. This |
932
|
|
|
|
|
|
|
is normally called only from the L<Workflow> C<execute_action()> |
933
|
|
|
|
|
|
|
method. |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
This method respects transactions if the selected persister supports it. |
936
|
|
|
|
|
|
|
Currently, the DBI-based persisters will commit the workflow transaction |
937
|
|
|
|
|
|
|
if everything executes successfully and roll back if something fails. |
938
|
|
|
|
|
|
|
Note that you need to manage any L<Workflow::Persister::DBI::ExtraData> |
939
|
|
|
|
|
|
|
transactions yourself. |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
Returns: C<$workflow> |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=head3 get_workflow_history( $workflow ) |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
Retrieves all L<Workflow::History> objects related to C<$workflow>. |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
B<NOTE>: Normal users get the history objects from the L<Workflow> |
948
|
|
|
|
|
|
|
object itself. Under the covers it calls this. |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
Returns: list of L<Workflow::History> objects |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
=head3 get_action( $workflow, $action_name ) [ deprecated ] |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
Retrieves the action C<$action_name> from workflow C<$workflow>. Note |
955
|
|
|
|
|
|
|
that this does not do any checking as to whether the action is proper |
956
|
|
|
|
|
|
|
given the state of C<$workflow> or anything like that. It is mostly an |
957
|
|
|
|
|
|
|
internal method for L<Workflow> (which B<does> do checking as to the |
958
|
|
|
|
|
|
|
propriety of the action) to instantiate new actions. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Throws exception if no action with name C<$action_name> available. |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=head3 get_action_config( $workflow, $action_name ) |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
Retrieves the configuration for action C<$action_name> as specified in |
965
|
|
|
|
|
|
|
the actions configuration file, with the keys listed in |
966
|
|
|
|
|
|
|
L<the 'action' section of Workflow::Config|Workflow::Config/"action"> |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
Throws exception if no action with name C<$action_name> available. |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
Returns: A hash with the configuration as its keys. |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
=head3 get_persister( $persister_name ) |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
Retrieves the persister with name C<$persister_name>. |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
Throws exception if no persister with name C<$persister_name> |
977
|
|
|
|
|
|
|
available. |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
=head3 get_condition( $condition_name ) |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
Retrieves the condition with name C<$condition_name>. |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
Throws exception if no condition with name C<$condition_name> |
984
|
|
|
|
|
|
|
available. |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
=head3 get_validator( $validator_name ) |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
Retrieves the validator with name C<$validator_name>. |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
Throws exception if no validator with name C<$validator_name> |
991
|
|
|
|
|
|
|
available. |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
=head2 Internal Configuration Methods |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
=head3 _add_workflow_config( @config_hashrefs ) |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
Adds all configurations in C<@config_hashrefs> to the factory. Also |
998
|
|
|
|
|
|
|
cycles through the workflow states and creates a L<Workflow::State> |
999
|
|
|
|
|
|
|
object for each. These states are passed to the workflow when it is |
1000
|
|
|
|
|
|
|
instantiated. |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
We also require any necessary observer classes and throw an exception |
1003
|
|
|
|
|
|
|
if we cannot. If successful the observers are kept around and attached |
1004
|
|
|
|
|
|
|
to a workflow in L<create_workflow()|/create_workflow> and |
1005
|
|
|
|
|
|
|
L<fetch_workflow()|/fetch_workflow>. |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
Returns: nothing |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
=head3 _load_observers( $workflow_config_hashref ) |
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
Loads and adds observers based on workflow type |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
Returns number indicating amount of observers added, meaning zero can indicate success based on expected outcome. |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=head3 _add_action_config( @config_hashrefs ) |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
Adds all configurations in C<@config_hashrefs> to the factory, doing a |
1018
|
|
|
|
|
|
|
'require' on the class referenced in the 'class' attribute of each |
1019
|
|
|
|
|
|
|
action. |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
Throws an exception if there is no 'class' associated with an action |
1022
|
|
|
|
|
|
|
or if we cannot 'require' that class. |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
Returns: nothing |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
=head3 _add_persister_config( @config_hashrefs ) |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
Adds all configurations in C<@config_hashrefs> to the factory, doing a |
1029
|
|
|
|
|
|
|
'require' on the class referenced in the 'class' attribute of each |
1030
|
|
|
|
|
|
|
persister. |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
Throws an exception if there is no 'class' associated with a |
1033
|
|
|
|
|
|
|
persister, if we cannot 'require' that class, or if we cannot |
1034
|
|
|
|
|
|
|
instantiate an object of that class. |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
Returns: nothing |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=head3 _add_condition_config( @config_hashrefs ) |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
Adds all configurations in C<@config_hashrefs> to the factory, doing a |
1041
|
|
|
|
|
|
|
'require' on the class referenced in the 'class' attribute of each |
1042
|
|
|
|
|
|
|
condition. |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
Throws an exception if there is no 'class' associated with a |
1045
|
|
|
|
|
|
|
condition, if we cannot 'require' that class, or if we cannot |
1046
|
|
|
|
|
|
|
instantiate an object of that class. |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
Returns: nothing |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=head3 _add_validator_config( @config_hashrefs ) |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
Adds all configurations in C<@config_hashrefs> to the factory, doing a |
1053
|
|
|
|
|
|
|
'require' on the class referenced in the 'class' attribute of each |
1054
|
|
|
|
|
|
|
validator. |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
Throws an exception if there is no 'class' associated with a |
1057
|
|
|
|
|
|
|
validator, if we cannot 'require' that class, or if we cannot |
1058
|
|
|
|
|
|
|
instantiate an object of that class. |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
Returns: nothing |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=head3 _commit_transaction |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
Calls the commit method in the workflow's persister. |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
Returns: nothing |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
=head3 _rollback_transaction |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
Calls the rollback method in the workflow's persister. |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
=head3 associate_observers_with_workflow |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
Add defined observers with workflow. |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
The workflow has to be provided as the single parameter accepted by this |
1077
|
|
|
|
|
|
|
method. |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
The observers added will have to be of the type relevant to the workflow type. |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
=head3 new |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
The new method is a dummy constructor, since we are using a factory it makes |
1084
|
|
|
|
|
|
|
no sense to call new - and calling new will result in a L<Workflow::Exception> |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
L</instance> should be called or the imported 'FACTORY' should be utilized. |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
=head1 DYNAMIC CONFIG LOADING |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
If you have either a large set of config files or a set of very large |
1091
|
|
|
|
|
|
|
config files then you may not want to incur the overhead of loading |
1092
|
|
|
|
|
|
|
each and every one on startup if you cannot predict which set you will |
1093
|
|
|
|
|
|
|
use in that instance of your application. |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
This approach doesn't make much sense in a persistent environment such |
1096
|
|
|
|
|
|
|
as mod_perl but it may lower startup costs if you have regularly |
1097
|
|
|
|
|
|
|
scheduled scripts that may not need to touch all possible types of |
1098
|
|
|
|
|
|
|
workflow. |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
To do this you can specify a callback that the factory will use to |
1101
|
|
|
|
|
|
|
retrieve batched hashes of config declarations. Whenever an unknown |
1102
|
|
|
|
|
|
|
workflow name is encountered the factory will first try to load your |
1103
|
|
|
|
|
|
|
config declarations then continue. |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
The callback takes one argument which is the workflow type. It should |
1106
|
|
|
|
|
|
|
return a reference to a hash of arguments in a form suitable for |
1107
|
|
|
|
|
|
|
C<add_config_from_file>. |
1108
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
For example: |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
use Workflow::Factory qw(FACTORY); |
1112
|
|
|
|
|
|
|
use My::Config::System; |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
sub init { |
1115
|
|
|
|
|
|
|
my $self = shift; |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
FACTORY->config_callback( |
1118
|
|
|
|
|
|
|
sub { |
1119
|
|
|
|
|
|
|
my $wf_type = shift; |
1120
|
|
|
|
|
|
|
my %ret = My::Config::System->get_files_for_wf( $wf_type ) || (); |
1121
|
|
|
|
|
|
|
return \%ret; |
1122
|
|
|
|
|
|
|
} |
1123
|
|
|
|
|
|
|
); |
1124
|
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
=head1 SUBCLASSING |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
=head2 Implementation and Usage |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
You can subclass the factory to implement your own methods and still |
1131
|
|
|
|
|
|
|
use the useful facade of the C<FACTORY> constant. For instance, the |
1132
|
|
|
|
|
|
|
implementation is typical Perl subclassing: |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
package My::Cool::Factory; |
1135
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
use strict; |
1137
|
|
|
|
|
|
|
use base qw( Workflow::Factory ); |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
sub some_cool_method { |
1140
|
|
|
|
|
|
|
my ( $self ) = @_; |
1141
|
|
|
|
|
|
|
... |
1142
|
|
|
|
|
|
|
} |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
To use your factory you can just do the typical import: |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
#!/usr/bin/perl |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
use strict; |
1149
|
|
|
|
|
|
|
use My::Cool::Factory qw( FACTORY ); |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
Or you can call C<instance()> directly: |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
#!/usr/bin/perl |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
use strict; |
1156
|
|
|
|
|
|
|
use My::Cool::Factory; |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
my $factory = My::Cool::Factory->instance(); |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=head1 GLOBAL RUN-TIME OPTIONS |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
Setting package variable B<$VALIDATE_ACTION_CONFIG> to a true value (it |
1163
|
|
|
|
|
|
|
is undef by default) turns on optional validation of extra attributes |
1164
|
|
|
|
|
|
|
of L<Workflow::Action> configs. See L<Workflow::Action> for details. |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=head1 SEE ALSO |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
=over |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
=item * L<Workflow> |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
=item * L<Workflow::Action> |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
=item * L<Workflow::Condition> |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
=item * L<Workflow::Config> |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
=item * L<Workflow::Persister> |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
=item * L<Workflow::Validator> |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
=back |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
Copyright (c) 2003-2022 Chris Winters. All rights reserved. |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
1189
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
Please see the F<LICENSE> |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
=head1 AUTHORS |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
Please see L<Workflow> |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
=cut |