File Coverage

lib/Workflow/Factory.pm
Criterion Covered Total %
statement 365 434 84.1
branch 106 140 75.7
condition 22 38 57.8
subroutine 43 50 86.0
pod 17 17 100.0
total 553 679 81.4


line stmt bran cond sub pod time code
1              
2             use warnings;
3 20     20   1404413 use strict;
  20         68  
  20         753  
4 20     20   147 use base qw( Workflow::Base );
  20         50  
  20         506  
5 20     20   101 use DateTime;
  20         34  
  20         4145  
6 20     20   1001 use Log::Log4perl qw( get_logger );
  20         438575  
  20         608  
7 20     20   95 use Workflow::Exception qw( configuration_error workflow_error );
  20         34  
  20         133  
8 20     20   4797 use Carp qw(croak);
  20         39  
  20         1319  
9 20     20   124 use English qw( -no_match_vars );
  20         56  
  20         992  
10 20     20   5662 $Workflow::Factory::VERSION = '1.60';
  20         17948  
  20         125  
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   116711 $class = ref $class || $class; # just in case
20             my $package = caller;
21 95   33     601 my $log = get_logger(__PACKAGE__);
22 95         258 if ( defined $_[0] && $_[0] eq 'FACTORY' ) {
23 95         1124 shift;
24 95 100 66     12974 my $instance;
25 93         153  
26 93         147 my $import_target = $package . '::FACTORY';
27             no strict 'refs';
28 93         227 unless ( defined &{$import_target} ) {
29 20     20   8984 *{$import_target} = sub {
  20         55  
  20         29103  
30 93 50       156 return $instance if $instance;
  93         572  
31 93         383 $instance = _initialize_instance($class);
32 23 100   23   9501 return $instance;
33 16         99 };
34 16         97 }
35 93         377 }
36             $class->SUPER::import(@_);
37             }
38 95         453  
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 1137 workflow_error "Please call 'instance()' or import the 'FACTORY' object ",
60 2   33     19 "to get the '$class' object rather than instantiating a ",
61             "new one directly.";
62 2         17 }
63              
64             my $proto = shift;
65             my $class = ref $proto || $proto;
66              
67             return _initialize_instance($class);
68 30     30 1 19964 }
69 30   33     262  
70             my ($class) = @_;
71 30         111  
72             my $log = get_logger(__PACKAGE__);
73             unless ( $INSTANCES{$class} ) {
74             $log->debug( "Creating empty instance of '$class' factory for ",
75 46     46   135 "singleton use" );
76             my $instance = bless {} => $class;
77 46         185 $instance->init();
78 46 100       1896 $INSTANCES{$class} = $instance;
79 17         136 }
80             return $INSTANCES{$class};
81 17         8731 }
82 17         177  
83 17         41 my ($class) = @_;
84              
85 46         135 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 2605 sub { "Using '$type' configuration file(s): " .
106 16 50       96 join( ', ', _flatten( $params{$type} ) ) } );
107             }
108 16         109  
109             $self->log->debug( "Adding condition configurations..." );
110 16         101  
111             if ( ref $params{condition} eq 'ARRAY' ) {
112             foreach my $condition ( @{ $params{condition} } ) {
113 57     54   11751 $self->_add_condition_config(
  54         1222  
114             Workflow::Config->parse_all_files( 'condition', $condition )
115             );
116 16         4340 }
117             } else {
118 16 100       4331 $self->_add_condition_config(
119 10         24 Workflow::Config->parse_all_files(
  10         36  
120 20         3190 '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         45 $self->_add_validator_config(
130             Workflow::Config->parse_all_files( 'validator', $validator )
131             );
132 16         4324 }
133             } else {
134 16 100       4377 $self->_add_validator_config(
135 1         2 Workflow::Config->parse_all_files(
  1         4  
136 2         603 '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         154 $self->_add_persister_config(
146             Workflow::Config->parse_all_files( 'persister', $persister )
147             );
148 16         4323 }
149             } else {
150 16 50       4616 $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         165 $self->_add_action_config(
162             Workflow::Config->parse_all_files( 'action', $action ) );
163             }
164 16         76 } else {
165             $self->_add_action_config(
166 16 100       4496 Workflow::Config->parse_all_files( 'action', $params{action} ) );
167 10         24 }
  10         33  
168 21         172  
169             $self->log->debug( "Adding workflow configurations..." );
170              
171             if ( ref $params{workflow} eq 'ARRAY' ) {
172             foreach my $workflow ( @{ $params{workflow} } ) {
173 6         34 $self->_add_workflow_config(
174             Workflow::Config->parse_all_files( 'workflow', $workflow ) );
175             }
176 16         96 } else {
177             $self->_add_workflow_config(
178 16 100       4391 Workflow::Config->parse_all_files(
179 10         27 'workflow', $params{workflow}
  10         185  
180 28         235 )
181             );
182             }
183              
184             return;
185             }
186              
187             my ( $self, %params ) = @_;
188 6         59 return unless ( scalar keys %params );
189             _check_config_keys(%params);
190             $self->_add_condition_config( _flatten( $params{condition} ) );
191 16         313 $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 18128 return;
196 25 50       117 }
197 25         102  
198 25         105 my (%params) = @_;
199 25         387 my @bad_keys
200 25         565 = grep { !Workflow::Config->is_valid_config_type($_) } keys %params;
201 25         4421 if ( scalar @bad_keys ) {
202 24         97 workflow_error "You tried to add configuration information to the ",
203 23         106 "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   150 }
208             }
209 41         258  
  89         775  
210 41 50       191 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   401 foreach my $workflow_config (@all_workflow_config) {
221 178 100       789 next unless ( ref $workflow_config eq 'HASH' );
  49         257  
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   155 foreach my $state_conf ( @{ $workflow_config->{state} } ) {
229 58 50       211  
230             # Add the workflow type to the state conf.
231 58         159 $state_conf->{type} = $wf_type;
232 58 100       211 my $wf_state = Workflow::State->new( $state_conf, $self );
233 42         102  
234 42         236 push @{ $self->{_workflow_state}{$wf_type} }, $wf_state;
235             }
236              
237             my $wf_class = $workflow_config->{class};
238             if ( $wf_class ) {
239 42         75 $self->_load_class( $wf_class,
  42         117  
240             q{Cannot require workflow class '%s': %s} );
241             }
242 138         276 $self->_load_observers($workflow_config);
243 138         735  
244             $self->log->info( "Added all workflow states..." );
245 138         162 }
  138         432  
246              
247             return;
248 42         122 }
249 42 100       107  
250 1         5 # Load all the observers so they're available when we instantiate the
251             # workflow
252              
253 42         174 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         10732 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   81 = $observer_sub =~ /^(.*)::(.*)$/;
266 42         87 $self->_load_class( $observer_class,
267 42   100     198 "Cannot require observer '%s' with sub '$observer_sub' to "
268 42         86 . "watch observer of type '$wf_type': %s" );
269 42         119 my $o_sub_name = $observer_class . '::' . $observer_sub;
  42         93  
270 3 100       16 if (exists &$o_sub_name) {
    50          
271 1         7 no strict 'refs';
272             push @observers, \&{ $o_sub_name };
273             } else {
274 1     9   7 my $error = 'subroutine not found';
  9         90  
275             $self->log->error( "Error loading subroutine '$observer_sub' in ",
276 2         18 "class '$observer_class': $error" );
277             workflow_error $error;
278 2         11 }
279             } else {
280             workflow_error "Cannot add observer to '$wf_type': you must ",
281 2         7 "have either 'class' or 'sub' defined. (See ",
282 2 100       8 "Workflow::Factory docs for details.)";
283 20     20   196 }
  20         39  
  20         33158  
284 1         2 }
  1         5  
285              
286 1         12 my $observers_num = scalar @observers;
287 1         4  
288             if (@observers) {
289 1         358 $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         74 $self->log->info( "No observers added to '$wf_type'" );
299             }
300 41 100       81  
301 1         4 return $observers_num;
302             }
303              
304 1     1   23 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         110 $self->log->error($full_msg);
309             workflow_error $full_msg;
310 40         181 }
311              
312             }
313 41         11068  
314             my ( $self, $wf_type, $context, $wf_class ) = @_;
315             my $wf_config = $self->_get_workflow_config($wf_type);
316              
317 4     4   8 unless ($wf_config) {
318 4         196 workflow_error "No workflow of type '$wf_type' available";
319 4 50       646 }
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 15717 $self->log->info( "Instantiated workflow object properly, persisting..." );
329 23         103 my $persister = $self->get_persister( $wf_config->{persister} );
330             my $id = $persister->create_workflow($wf);
331 23 100       80 $wf->id($id);
332 2         12 $self->log->info("Persisted workflow with ID '$id'; creating history...");
333             $persister->create_history(
334             $wf,
335 21 50 100     190 Workflow::History->new(
336             { workflow_id => $id,
337             action => $persister->get_create_action($wf),
338             description => $persister->get_create_description($wf),
339 21   33     315 user => $persister->get_create_user($wf),
340 21   33     281 state => $wf->state,
341 21         86 date => DateTime->now( time_zone => $wf->time_zone() ),
342 21         88 time_zone => $wf->time_zone(),
343 21         6017 }
344 21         120 )
345 21         309 );
346 21         86 $self->log->info( "Created history object ok" );
347 21         5779  
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         379  
361             return $wf;
362 21         5611 }
363              
364 21         141 my ( $self, $wf_type, $wf_id, $context, $wf_class ) = @_;
365 21 50       159 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         118 $wf_class = $wf_config->{class} || 'Workflow' unless ($wf_class);
373 21         98  
374             return unless ($wf_info);
375 21         273  
376             $wf_info->{last_update} ||= '';
377             $self->log->debug(
378             "Fetched data for workflow '$wf_id' ok: ",
379 8     8 1 29341 "[State: $wf_info->{state}] ",
380 8         26 "[Last update: $wf_info->{last_update}]"
381             );
382 8 50       27 my $wf = $wf_class->new( $wf_id, $wf_info->{state}, $wf_config,
383 0         0 $self->{_workflow_state}{$wf_type}, $self );
384              
385 8         27 $wf->context( $wf_info->{context} || Workflow::Context->new ); #if ( not $wf->context() );
386 8         45 $wf->last_update( $wf_info->{last_update} );
387 8 50 100     2432  
388             $persister->fetch_extra_workflow_data($wf);
389 8 100       34  
390             $self->associate_observers_with_workflow($wf);
391 6   50     18 $wf->notify_observers('fetch');
392 6         40  
393             return $wf;
394             }
395              
396             my ( $self, $wf ) = @_;
397             my $observers = $self->{_workflow_observers}{ $wf->type };
398 6         2062 return unless ( ref $observers eq 'ARRAY' );
399             $wf->add_observer($_) for ( @{$observers} );
400 6   66     36 }
401 6         20  
402             my $self = shift;
403 6         44 my $wf_type = shift;
404              
405 6         20 if ( ref( $self->config_callback ) eq 'CODE' ) {
406 6         19 my $args = &{ $self->config_callback }($wf_type);
407             $self->add_config_from_file( %{$args} ) if $args && %{$args};
408 6         32 }
409             }
410              
411             my ( $self, $wf_type ) = @_;
412 27     27 1 62 $self->_initialize_workflow_config($wf_type)
413 27         98 unless $self->{_workflow_config}{$wf_type};
414 27 100       357 return $self->{_workflow_config}{$wf_type};
415 5         6 }
  5         20  
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       11 return $wf;
423 2         30  
  2         6  
424 2 100 66     30 }
  1         54  
  2         11  
425              
426             my ( $self, $wf ) = @_;
427              
428             my $old_update = $wf->last_update;
429 163     163   1459 $wf->last_update( DateTime->now( time_zone => $wf->time_zone() ) );
430              
431 163 100       697 my $wf_config = $self->_get_workflow_config( $wf->type );
432 163         412 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 623 }
447              
448 54         147 $wf->notify_observers('save');
449 54         548  
450             return $wf;
451 54         260 }
452 54         246  
453 54         86 # Only implemented for DBI. Don't know if this could be implemented
454 54         276 # for other persisters.
455 54         7656 my ( $self, $wf ) = @_;
456 54         6735  
457 54         140 my $wf_config = $self->_get_workflow_config( $wf->type );
458 9         41 my $persister = $self->get_persister( $wf_config->{persister} );
459             $persister->commit_transaction();
460 54         442 $self->log->debug('Committed transaction.');
461 54         159 return;
462             }
463 54 50       6106  
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         214 $persister->rollback_transaction();
469             $self->log->debug('Rolled back transaction.');
470 54         821 return;
471             }
472              
473             my ( $self, $wf ) = @_;
474              
475             $self->log->debug( "Trying to fetch history for workflow ", $wf->id );
476 74     74   578 my $wf_config = $self->_get_workflow_config( $wf->type );
477             my $persister = $self->get_persister( $wf_config->{persister} );
478 74         218 return $persister->fetch_history($wf);
479 74         276 }
480 74         307  
481 74         789 ########################################
482 74         11848 # 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 48  
497             my $action;
498 4         12 if ( exists $actions->{action} ) {
499 4         1202 $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   174 $self->{_action_config}{$type}{$name} = $action_config;
509             my $action_class = $action_config->{class};
510 52 100       186 unless ($action_class) {
511             configuration_error
512 51         133 "Action '$name' must be associated with a ",
513 51 100       190 "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       135 my $msg = $EVAL_ERROR;
520             $msg =~ s/\\n/ /g;
521 33         67 configuration_error
522 33 100       89 "Cannot include action class '$action_class': $msg";
523 31         70 }
524             $self->log->debug(
525 2         4 "Included action '$name' class '$action_class' ok");
  2         3  
526             if ($self->_validate_action_config) {
527             my $validate_name = $action_class . '::validate_config';
528 33         51 if (exists &$validate_name) {
  33         77  
529 139         280 no strict 'refs';
530 139         405 $self->log->debug(
531             "Validating configuration for action '$name'");
532 139         35176 $validate_name->($action_config);
533 139         375 }
534 139 50       325 }
535 0         0 } # End action for.
536             }
537             }
538              
539             my ( $self, $wf, $action_name ) = @_;
540 139         390 my $config = $self->{_action_config}{ $wf->type }{$action_name};
541 139         43321 $config = $self->{_action_config}{default}{$action_name}
542 139 50       21139 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         452  
550 139 100       38369 my ( $self, $wf, $action_name ) = @_;
551 3         9 my $config = $self->get_action_config( $wf, $action_name );;
552 3 100       14 my $action_class = $config->{class};
553 20     20   228 return $action_class->new( $wf, $config );
  20         66  
  20         30124  
554 2         6 }
555              
556 2         543 ########################################
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 729 next unless ( ref $persister_config eq 'HASH' );
565 60         212 my $name = $persister_config->{name};
566             $self->log->debug( "Adding configuration for persister '$name'" );
567 60 100 66     818 $self->{_persister_config}{$name} = $persister_config;
  5         27  
568             my $persister_class = $persister_config->{class};
569 60 50       179 unless ($persister_class) {
570 0         0 configuration_error "You must specify a 'class' in persister ",
571             "'$name' configuration";
572 60         151 }
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   108 "'$name' of class '$persister_class': $EVAL_ERROR";
587             }
588 41 100       138 $self->{_persister}{$name} = $persister;
589             $self->log->debug( "Instantiated persister '$name' ok" );
590 25         63 }
591 27 100       402 }
592 16         38  
593 16         79 my ( $self, $persister_name ) = @_;
594 16         4075 my $persister = $self->{_persister}{$persister_name};
595 16         45 unless ($persister) {
596 16 50       64 workflow_error "No persister with name '$persister_name' available";
597 0         0 }
598             return $persister;
599             }
600              
601 16         60 my $self = shift;
602 16         4923 my @persisters = sort keys %{ $self->{_persister} };
603 16 50       98  
604 0         0 return @persisters;
605             }
606              
607             my $self = shift;
608 16         78  
609             my ($type) = @_;
610 16         6533 my $wf_config = $self->_get_workflow_config($type);
  16         190  
611 16 50       64 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         58  
616 16         148 return $persister;
617             }
618              
619             ########################################
620             # CONDITIONS
621 188     188 1 1393  
622 188         406 my ( $self, @all_condition_config ) = @_;
623 188 50       474  
624 0         0 return unless ( scalar @all_condition_config );
625              
626 188         316 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   144 "'$condition_class': $EVAL_ERROR";
654             }
655 51 100       158 $self->log->debug(
656             "Included condition '$name' class '$condition_class' ",
657 50         175 "ok; now try to instantiate condition..." );
658 51 100       543 my $condition = eval { $condition_class->new($condition_config) };
659             if ($EVAL_ERROR) {
660             configuration_error
661 27 100       119 "Cannot create condition '$name': $EVAL_ERROR";
662             }
663 27         46 $self->{_conditions}{$type}{$name} = $condition;
664 27 100       92 $self->log->debug( "Instantiated condition '$name' ok" );
665 25         60 }
666             }
667 2         4 }
  2         5  
668              
669             my ( $self, $name, $type ) = @_;
670 27         44  
  27         65  
671 41         784 my $condition;
672 41         204  
673 41         8786 if ( defined $type ) {
674 41         109 $condition = $self->{_conditions}{$type}{$name};
675 41 50       98 }
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         115 if ( not defined $condition ) {
681 41         11927 $condition = $self->{_conditions}{'default'}{$name};
682 41 50       7042 }
683 0         0  
684             if ( not defined $condition
685             and $name =~ m/ \A ! /msx ) {
686             my $negated = $name;
687 41         171 $negated =~ s/ \A ! //gx;
688              
689 41         10203 if ( $self->get_condition( $negated, $type ) ) {
  41         367  
690 41 50       106 $condition = Workflow::Condition::Negated->new(
691 0         0 { name => $name }
692             );
693              
694 41         166 $type = 'default' unless defined $type;
695 41         115 $self->{_conditions}{$type}{$name} = $condition;
696             }
697             }
698              
699             unless ($condition) {
700             workflow_error "No condition with name '$name' available";
701 232     232 1 3884 }
702             return $condition;
703 232         345 }
704              
705 232 100       452 ########################################
706 231         671 # VALIDATORS
707              
708             my ( $self, @all_validator_config ) = @_;
709              
710             return unless (@all_validator_config);
711              
712 232 100       475 foreach my $validators (@all_validator_config) {
713 175         440 next unless ( ref $validators eq 'HASH' );
714              
715             my $v;
716 232 100 66     636 if ( exists $validators->{validator} ) {
717             $v = $validators->{validator};
718 13         18 } else {
719 13         46 push @{$v}, $validators;
720             }
721 13 50       32  
722 13         88 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       36 my $validator_class = $validator_config->{class};
727 13         58 unless ($validator_class) {
728             configuration_error
729             "Validator '$name' must be associated with ",
730             "a class using the 'class' attribute.";
731 232 50       868 }
732 0         0 $self->log->debug(
733             "Trying to include validator class '$validator_class'");
734 232         486 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   135 " ok; now try to instantiate validator..."
742             );
743 42 100       130 my $validator = eval { $validator_class->new($validator_config) };
744             if ($EVAL_ERROR) {
745 37         101 workflow_error "Cannot create validator '$name': $EVAL_ERROR";
746 37 100       152 }
747             $self->{_validators}{$name} = $validator;
748 13         74 $self->log->debug( "Instantiated validator '$name' ok" );
749 13 100       55 }
750 12         33 }
751             }
752 1         3  
  1         2  
753             my ( $self, $name ) = @_;
754             unless ( $self->{_validators}{$name} ) {
755 13         30 workflow_error "No validator with name '$name' available";
  13         38  
756 13         34 }
757 13         70 return $self->{_validators}{$name};
758 13         3910 }
759 13         46  
760 13 50       52 my $self = shift;
761 0         0 my @validators = sort keys %{ $self->{_validators} };
762             return @validators;
763             }
764              
765             return $VALIDATE_ACTION_CONFIG;
766 13         56 }
767 13         4823  
768 13 50       99 1;
769 0         0  
770              
771             =pod
772              
773 13         99 =head1 NAME
774              
775             Workflow::Factory - Generates new workflow and supporting objects
776 13         6256  
  13         134  
777 13 50       61 =head1 VERSION
778 0         0  
779             This documentation describes version 1.60 of this package
780 13         212  
781 13         59 =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       67 action => [ 'myactions.xml', 'otheractions.xml' ],
789 0         0 validator => [ 'validator.xml', 'myvalidators.xml' ],
790             condition => 'condition.xml',
791 13         50 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   565 =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