File Coverage

blib/lib/Workflow/Factory.pm
Criterion Covered Total %
statement 369 417 88.4
branch 103 130 79.2
condition 27 42 64.2
subroutine 48 56 85.7
pod 17 17 100.0
total 564 662 85.2


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