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   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