File Coverage

lib/Workflow/Persister.pm
Criterion Covered Total %
statement 66 79 83.5
branch 10 16 62.5
condition 4 7 57.1
subroutine 20 22 90.9
pod 15 15 100.0
total 115 139 82.7


line stmt bran cond sub pod time code
1              
2             use warnings;
3 22     22   611 use strict;
  22         36  
  22         735  
4 22     22   110 use base qw( Workflow::Base );
  22         34  
  22         543  
5 22     22   98 use English qw( -no_match_vars );
  22         29  
  22         2833  
6 22     22   1489 use Log::Log4perl qw( get_logger );
  22         4383  
  22         133  
7 22     22   6699 use Workflow::Exception qw( persist_error );
  22         40  
  22         154  
8 22     22   2075  
  22         34  
  22         999  
9             use constant DEFAULT_ID_LENGTH => 8;
10 22     22   132  
  22         36  
  22         18513  
11             $Workflow::Persister::VERSION = '1.61';
12              
13             my @FIELDS = qw( name class
14             use_random use_uuid
15             workflow_id_generator history_id_generator );
16             __PACKAGE__->mk_accessors(@FIELDS);
17              
18             my ( $self, $params ) = @_;
19             for (@FIELDS) {
20 16     16 1 39 $self->$_( $params->{$_} ) if ( $params->{$_} );
21 16         45 }
22 96 100       733 unless ( $self->use_random ) {
23             $self->use_random('no');
24 16 50       80 }
25 16         233 unless ( $self->use_uuid ) {
26             $self->use_uuid('no');
27 16 50       188 }
28 16         164 $self->log->info( "Initializing persister '", $self->name, "'" );
29             }
30 16         183  
31             ########################################
32             # COMMON GENERATOR ASSIGNMENTS
33              
34             my ( $self, $params ) = @_;
35             $params ||= {};
36              
37 16     16 1 35 my ( $wf_gen, $history_gen );
38 16   50     52 if ( $self->use_uuid eq 'yes' ) {
39             $self->log->debug("Assigning UUID generators by request");
40 16         28 ( $wf_gen, $history_gen ) = $self->init_uuid_generators($params);
41 16 50       44 } elsif ( $self->use_random eq 'yes' ) {
    100          
42 0         0 $self->log->debug("Assigning random ID generators by request");
43 0         0 ( $wf_gen, $history_gen ) = $self->init_random_generators($params);
44             }
45 2         41 if ( $wf_gen and $history_gen ) {
46 2         592 $self->workflow_id_generator($wf_gen);
47             $self->history_id_generator($history_gen);
48 16 100 66     352 }
49 2         15 }
50 2         26  
51             my ( $self, $params ) = @_;
52             my $length = $params->{id_length} || DEFAULT_ID_LENGTH;
53             eval { require Workflow::Persister::RandomId };
54             if (my $msg = $EVAL_ERROR) {
55 14     14 1 44 $msg =~ s/\\n/ /g;
56 14   50     124 $self->log->error($msg);
57 14         28 }
  14         85  
58 14 50       50 my $generator
59 0         0 = Workflow::Persister::RandomId->new( { id_length => $length } );
60 0         0 return ( $generator, $generator );
61             }
62 14         121  
63             my ( $self, $params ) = @_;
64 14         65  
65             eval { require Workflow::Persister::UUID };
66             if (my $msg = $EVAL_ERROR) {
67             $msg =~ s/\\n/ /g;
68 0     0 1 0 $self->log->error($msg);
69             }
70 0         0 my $generator = Workflow::Persister::UUID->new();
  0         0  
71 0 0       0 return ( $generator, $generator );
72 0         0 }
73 0         0  
74             ########################################
75 0         0 # INTERFACE METHODS
76 0         0  
77             my ( $self, $wf ) = @_;
78             persist_error "Persister '", ref($self), "' must implement ",
79             "'create_workflow()'";
80             }
81              
82             my ( $self, $wf ) = @_;
83 1     1 1 478 persist_error "Persister '", ref($self), "' must implement ",
84 1         3 "'update_workflow()'";
85             }
86              
87             my ( $self, $wf_id ) = @_;
88             persist_error "Persister '", ref($self), "' must implement ",
89 1     1 1 1179 "'fetch_workflow()'";
90 1         3 }
91              
92             # This is the only one that isn't required...
93             my ( $self, $wf ) = @_;
94              
95 1     1 1 857 $self->log->info("Called empty 'fetch_extra_workflow_data()' (ok)");
96 1         3 $self->log->debug(
97             "An empty implementation is not an error as you may ",
98             "not need this extra functionality. If you do you ",
99             "should use a persister for this purpose (e.g., ",
100             "Workflow::Persister::DBI::ExtraData) or ",
101             "create your own and just implement this method."
102 6     6 1 13 );
103             return;
104 6         13 }
105 6         1720  
106             my ( $self, $wf, @history ) = @_;
107             persist_error "Persister '", ref($self), "' must implement ",
108             "'create_history()'";
109             }
110              
111             my ( $self, $wf ) = @_;
112 6         1765 persist_error "Persister '", ref($self), "' must implement ",
113             "'fetch_history()'";
114             }
115              
116 1     1 1 846 my ( $self, $wf ) = @_;
117 1         2 return 'n/a';
118             }
119              
120             my ( $self, $wf ) = @_;
121             return 'Create new workflow';
122 1     1 1 878 }
123 1         3  
124             my ( $self, $wf ) = @_;
125             return 'Create workflow';
126             }
127              
128 21     21 1 47 # Only required for DBI persisters.
129 21         89 return;
130             }
131              
132             return;
133 21     21 1 55 }
134 21         109  
135             1;
136              
137              
138 21     21 1 61 =pod
139 21         184  
140             =head1 NAME
141              
142             Workflow::Persister - Base class for workflow persistence
143              
144 4     4 1 5 =head1 VERSION
145              
146             This documentation describes version 1.61 of this package
147              
148 0     0 1   =head1 SYNOPSIS
149              
150             # Associate a workflow with a persister
151             <workflow type="Ticket"
152             persister="MainDatabase">
153             ...
154              
155             # Declare a persister
156             <persister name="MainDatabase"
157             class="Workflow::Persister::DBI"
158             driver="MySQL"
159             dsn="DBI:mysql:database=workflows"
160             user="wf"
161             password="mypass"/>
162              
163             # Declare a separate persister
164             <persister name="FileSystem"
165             class="Workflow::Persister::File"
166             path="/path/to/my/workflow"/>
167              
168             =head1 DESCRIPTION
169              
170             This is the base class for persisting workflows. It does not implement
171             anything itself but actual implementations should subclass it to
172             ensure they fulfill the contract.
173              
174             The job of a persister is to create, update and fetch the workflow
175             object plus any data associated with the workflow. It also creates and
176             fetches workflow history records.
177              
178             =head1 SUBCLASSING
179              
180             =head2 Methods
181              
182             =head3 create_workflow( $workflow )
183              
184             Stub that warns that the method should be overwritten in the derived
185             Persister. Since this is a SUPER class.
186              
187             Generate an ID for the workflow, serialize the workflow data (ID and
188             state) and set the ID in the workflow.
189              
190             Returns the ID for the workflow.
191              
192             =head3 update_workflow( $workflow )
193              
194             Stub that warns that the method should be overwritten in the derived
195             Persister. Since this is a SUPER class.
196              
197             Update the workflow state.
198              
199             Returns nothing.
200              
201             =head3 fetch_workflow( $workflow_id )
202              
203             Stub that warns that the method should be overwritten in the derived
204             Persister. Since this is a SUPER class.
205              
206             Retrieve the workflow data corresponding to C<$workflow_id>. It not
207             found return undef, if found return a hashref with at least the keys
208             C<state> and C<last_update> (a L<DateTime> instance).
209              
210             =head3 create_history( $workflow, @history )
211              
212             Stub that warns that the method should be overwritten in the derived
213             Persister. Since this is a SUPER class.
214              
215             Serialize all objects in C<@history> for later retrieval.
216              
217             Returns C<@history>, the list of history objects, with the history
218             C<id> and C<saved> values set according to the saved results.
219              
220             =head3 fetch_history( $workflow )
221              
222             Stub that warns that the method should be overwritten in the derived
223             Persister. Since this is a SUPER class.
224              
225             The derived class method should return a list of L<Workflow::History> objects.
226              
227              
228             =head3 get_create_user( $workflow )
229              
230             When creating an initial L<Workflow::History> record to insert into the database,
231             the return value of this method is used for the value of the "user" field.
232              
233             Override this method to change the value from the default, "n/a".
234              
235             =head3 get_create_description( $workflow )
236              
237             When creating an initial L<Workflow::History> record to insert into the database,
238             the return value of this method is used for the value of the "description" field.
239              
240             Override this method to change the value from the default, "Create new workflow".
241              
242              
243             =head3 get_create_action( $workflow )
244              
245             When creating an initial L<Workflow::History> record to insert into the database,
246             the return value of this method is used for the value of the "action" field.
247              
248             Override this method to change the value from the default, "Create workflow".
249              
250              
251             =head3 assign_generators( \%params )
252              
253             Assigns proper generators based on intialization, see L</init>
254              
255             =head3 fetch_extra_workflow_data ( $workflow )
256              
257             A stub that warns that the method should be overwritten in the derived
258             Persister. Since this is a SUPER class.
259              
260             =head3 commit_transaction
261              
262             Commit the current transaction if the persister supports transactions.
263             This stub does not have to be overridden. It is not executed if
264             autocommit is on.
265              
266             =head3 rollback_transaction
267              
268             Roll back the current transaction if the persister supports transactions.
269             This stub does not have to be overridden. It is not executed if
270             autocommit is on.
271              
272             =head3 init
273              
274             Method to initialize persister based on configuration.
275              
276             =head3 init_random_generators( \%params )
277              
278             Initializes random id generators, takes the following named parameters:
279              
280             =over
281              
282             =item * length, of random id to be generated
283              
284             =back
285              
286             Returns two identical random id generator objects in list context.
287              
288             =head3 init_uuid_generators( \%params )
289              
290             Initializes UUID generators, takes no parameters
291              
292             Returns two identical UUID generator objects in list context.
293              
294             =head1 TODO
295              
296             =over
297              
298             =item * refactor init_random_generators, returns two similar objects?
299              
300             =item * refactor init_uuid_generators, returns two similar objects?
301              
302             =item * refactor init_uuid_generators, takes no parameters, even though
303             we shift parameters in?
304              
305             =back
306              
307             =head1 SEE ALSO
308              
309             =over
310              
311             =item * L<Workflow::Factory>
312              
313             =item * L<Workflow::History>
314              
315             =back
316              
317             =head1 COPYRIGHT
318              
319             Copyright (c) 2003-2022 Chris Winters. All rights reserved.
320              
321             This library is free software; you can redistribute it and/or modify
322             it under the same terms as Perl itself.
323              
324             Please see the F<LICENSE>
325              
326             =head1 AUTHORS
327              
328             Please see L<Workflow>
329              
330             =cut