line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Workflow::Persister::DBI; |
2
|
|
|
|
|
|
|
|
3
|
13
|
|
|
13
|
|
36190
|
use warnings; |
|
13
|
|
|
|
|
28
|
|
|
13
|
|
|
|
|
543
|
|
4
|
13
|
|
|
13
|
|
81
|
use strict; |
|
13
|
|
|
|
|
37
|
|
|
13
|
|
|
|
|
374
|
|
5
|
13
|
|
|
13
|
|
73
|
use base qw( Workflow::Persister ); |
|
13
|
|
|
|
|
34
|
|
|
13
|
|
|
|
|
2345
|
|
6
|
13
|
|
|
13
|
|
2188
|
use DateTime; |
|
13
|
|
|
|
|
1098513
|
|
|
13
|
|
|
|
|
454
|
|
7
|
13
|
|
|
13
|
|
5514
|
use DateTime::Format::Strptime; |
|
13
|
|
|
|
|
1644249
|
|
|
13
|
|
|
|
|
97
|
|
8
|
13
|
|
|
13
|
|
16162
|
use DBI; |
|
13
|
|
|
|
|
146422
|
|
|
13
|
|
|
|
|
968
|
|
9
|
13
|
|
|
13
|
|
114
|
use Log::Log4perl qw( get_logger ); |
|
13
|
|
|
|
|
34
|
|
|
13
|
|
|
|
|
153
|
|
10
|
13
|
|
|
13
|
|
1124
|
use Workflow::Exception qw( configuration_error persist_error ); |
|
13
|
|
|
|
|
193
|
|
|
13
|
|
|
|
|
757
|
|
11
|
13
|
|
|
13
|
|
1256
|
use Workflow::History; |
|
13
|
|
|
|
|
36
|
|
|
13
|
|
|
|
|
219
|
|
12
|
13
|
|
|
13
|
|
4324
|
use Workflow::Persister::RandomId; |
|
13
|
|
|
|
|
32
|
|
|
13
|
|
|
|
|
103
|
|
13
|
13
|
|
|
13
|
|
5568
|
use Workflow::Persister::DBI::AutoGeneratedId; |
|
13
|
|
|
|
|
35
|
|
|
13
|
|
|
|
|
77
|
|
14
|
13
|
|
|
13
|
|
5082
|
use Workflow::Persister::DBI::SequenceId; |
|
13
|
|
|
|
|
287
|
|
|
13
|
|
|
|
|
93
|
|
15
|
13
|
|
|
13
|
|
602
|
use Carp qw(croak); |
|
13
|
|
|
|
|
29
|
|
|
13
|
|
|
|
|
704
|
|
16
|
13
|
|
|
13
|
|
199
|
use English qw( -no_match_vars ); |
|
13
|
|
|
|
|
29
|
|
|
13
|
|
|
|
|
81
|
|
17
|
13
|
|
|
13
|
|
11661
|
use Readonly; |
|
13
|
|
|
|
|
56283
|
|
|
13
|
|
|
|
|
37456
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Readonly::Scalar my $TRUE => 1; |
20
|
|
|
|
|
|
|
Readonly::Scalar my $FALSE => 0; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
$Workflow::Persister::DBI::VERSION = '1.62'; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my @FIELDS = qw( _wf_fields _hist_fields handle dsn user password driver |
25
|
|
|
|
|
|
|
workflow_table history_table date_format parser autocommit); |
26
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(@FIELDS); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub init { |
30
|
14
|
|
|
14
|
1
|
41
|
my ( $self, $params ) = @_; |
31
|
14
|
|
|
|
|
152
|
$self->SUPER::init($params); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Default to old date format if not provided so we don't break old configurations. |
34
|
14
|
|
|
|
|
11884
|
$self->date_format('%Y-%m-%d %H:%M'); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Default to autocommit on for backward compatibility. |
37
|
14
|
|
|
|
|
211
|
$self->autocommit($TRUE); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Load user-provided values from config. |
40
|
14
|
|
|
|
|
163
|
for (qw( dsn user password date_format autocommit )) { |
41
|
70
|
100
|
|
|
|
623
|
$self->$_( $params->{$_} ) if ( defined $params->{$_} ); |
42
|
|
|
|
|
|
|
} |
43
|
14
|
|
|
|
|
93
|
$self->handle($self->create_handle); |
44
|
|
|
|
|
|
|
my $driver |
45
|
14
|
100
|
50
|
|
|
226
|
= $self->handle ? $self->handle->{Driver}->{Name} : ($params->{driver} || ''); |
46
|
14
|
|
|
|
|
909
|
$self->log->debug( "Pulled driver '$driver' from DBI DSN" ); |
47
|
14
|
|
|
|
|
4008
|
$self->driver($driver); |
48
|
14
|
|
|
|
|
248
|
$self->assign_generators( $params, $driver ); |
49
|
14
|
|
|
|
|
168
|
$self->log->info( |
50
|
|
|
|
|
|
|
"Assigned workflow generator '", |
51
|
|
|
|
|
|
|
ref( $self->workflow_id_generator ), |
52
|
|
|
|
|
|
|
"'; ", |
53
|
|
|
|
|
|
|
"history generator '", |
54
|
|
|
|
|
|
|
ref( $self->history_id_generator ), |
55
|
|
|
|
|
|
|
"'" |
56
|
|
|
|
|
|
|
); |
57
|
14
|
|
|
|
|
4497
|
$self->assign_tables($params); |
58
|
14
|
|
|
|
|
229
|
$self->log->info( |
59
|
|
|
|
|
|
|
"Assigned workflow table '", |
60
|
|
|
|
|
|
|
$self->workflow_table, "'; ", "history table '", |
61
|
|
|
|
|
|
|
$self->history_table, "'" |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
14
|
|
|
|
|
4260
|
my $parser |
65
|
|
|
|
|
|
|
= DateTime::Format::Strptime->new( pattern => $self->date_format ); |
66
|
14
|
|
|
|
|
26346
|
$self->parser($parser); |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub create_handle { |
70
|
13
|
|
|
13
|
1
|
45
|
my ($self, $params) = @_; |
71
|
13
|
50
|
|
|
|
46
|
unless ( $self->dsn ) { |
72
|
0
|
|
|
|
|
0
|
configuration_error "DBI persister configuration must include ", |
73
|
|
|
|
|
|
|
"key 'dsn' which maps to the first paramter ", |
74
|
|
|
|
|
|
|
"in the DBI 'connect()' call."; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
13
|
|
|
|
|
177
|
local $EVAL_ERROR = undef; |
78
|
13
|
|
|
|
|
32
|
my $dbh = eval { |
79
|
13
|
50
|
|
|
|
62
|
DBI->connect( $self->dsn, $self->user, $self->password ) |
80
|
|
|
|
|
|
|
|| croak "Cannot connect to database: $DBI::errstr"; |
81
|
|
|
|
|
|
|
}; |
82
|
13
|
50
|
|
|
|
192708
|
if ($EVAL_ERROR) { |
83
|
0
|
|
|
|
|
0
|
persist_error $EVAL_ERROR; |
84
|
|
|
|
|
|
|
} |
85
|
13
|
|
|
|
|
75
|
$dbh->{RaiseError} = $TRUE; |
86
|
13
|
|
|
|
|
279
|
$dbh->{PrintError} = $FALSE; |
87
|
13
|
|
|
|
|
266
|
$dbh->{ChopBlanks} = $TRUE; |
88
|
13
|
|
|
|
|
275
|
$dbh->{AutoCommit} = $self->autocommit(); |
89
|
13
|
|
|
|
|
494
|
$self->log->debug( "Connected to database '", |
90
|
|
|
|
|
|
|
$self->dsn, "' and ", "assigned to persister ok" ); |
91
|
|
|
|
|
|
|
|
92
|
13
|
|
|
|
|
4497
|
return $dbh; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub assign_generators { |
96
|
14
|
|
|
14
|
1
|
43
|
my ( $self, $params, $driver ) = @_; |
97
|
14
|
|
|
|
|
164
|
$self->SUPER::assign_generators($params); |
98
|
|
|
|
|
|
|
return |
99
|
14
|
50
|
33
|
|
|
99
|
if ($self->workflow_id_generator |
100
|
|
|
|
|
|
|
and $self->history_id_generator ); |
101
|
|
|
|
|
|
|
|
102
|
14
|
|
|
|
|
199
|
my ( $wf_gen, $history_gen ); |
103
|
14
|
100
|
|
|
|
145
|
if ( $driver eq 'Pg' ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
104
|
1
|
|
|
|
|
4
|
$self->log->debug("Assigning ID generators for PostgreSQL"); |
105
|
1
|
|
|
|
|
363
|
( $wf_gen, $history_gen ) = $self->init_postgres_generators($params); |
106
|
|
|
|
|
|
|
} elsif ( $driver eq 'Oracle' ) { |
107
|
0
|
|
|
|
|
0
|
$self->log->debug("Assigning ID generators for Oracle"); |
108
|
0
|
|
|
|
|
0
|
( $wf_gen, $history_gen ) = $self->init_oracle_generators($params); |
109
|
|
|
|
|
|
|
} elsif ( $driver eq 'mysql' ) { |
110
|
0
|
|
|
|
|
0
|
$self->log->debug("Assigning ID generators for MySQL"); |
111
|
0
|
|
|
|
|
0
|
( $wf_gen, $history_gen ) = $self->init_mysql_generators($params); |
112
|
|
|
|
|
|
|
} elsif ( $driver eq 'SQLite' ) { |
113
|
1
|
|
|
|
|
5
|
$self->log->debug("Assigning ID generators for SQLite"); |
114
|
1
|
|
|
|
|
340
|
( $wf_gen, $history_gen ) = $self->init_sqlite_generators($params); |
115
|
|
|
|
|
|
|
} else { |
116
|
12
|
|
|
|
|
55
|
$self->log->debug("Assigning random ID generators"); |
117
|
12
|
|
|
|
|
3327
|
( $wf_gen, $history_gen ) = $self->init_random_generators($params); |
118
|
|
|
|
|
|
|
} |
119
|
14
|
|
|
|
|
83
|
$self->workflow_id_generator($wf_gen); |
120
|
14
|
|
|
|
|
253
|
$self->history_id_generator($history_gen); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub init_postgres_generators { |
124
|
1
|
|
|
1
|
1
|
3
|
my ( $self, $params ) = @_; |
125
|
1
|
|
|
|
|
4
|
my $sequence_select = q{SELECT NEXTVAL( '%s' )}; |
126
|
1
|
|
50
|
|
|
8
|
$params->{workflow_sequence} ||= 'workflow_seq'; |
127
|
1
|
|
50
|
|
|
7
|
$params->{history_sequence} ||= 'workflow_history_seq'; |
128
|
|
|
|
|
|
|
return ( |
129
|
|
|
|
|
|
|
Workflow::Persister::DBI::SequenceId->new( |
130
|
|
|
|
|
|
|
{ sequence_name => $params->{workflow_sequence}, |
131
|
|
|
|
|
|
|
sequence_select => $sequence_select |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
), |
134
|
|
|
|
|
|
|
Workflow::Persister::DBI::SequenceId->new( |
135
|
|
|
|
|
|
|
{ sequence_name => $params->{history_sequence}, |
136
|
1
|
|
|
|
|
14
|
sequence_select => $sequence_select |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
) |
139
|
|
|
|
|
|
|
); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub init_oracle_generators { |
143
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $params ) = @_; |
144
|
0
|
|
|
|
|
0
|
my $sequence_select = q{SELECT %s.NEXTVAL from dual}; |
145
|
0
|
|
0
|
|
|
0
|
$params->{workflow_sequence} ||= 'workflow_seq'; |
146
|
0
|
|
0
|
|
|
0
|
$params->{history_sequence} ||= 'workflow_history_seq'; |
147
|
|
|
|
|
|
|
return ( |
148
|
|
|
|
|
|
|
Workflow::Persister::DBI::SequenceId->new( |
149
|
|
|
|
|
|
|
{ sequence_name => $params->{workflow_sequence}, |
150
|
|
|
|
|
|
|
sequence_select => $sequence_select |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
), |
153
|
|
|
|
|
|
|
Workflow::Persister::DBI::SequenceId->new( |
154
|
|
|
|
|
|
|
{ sequence_name => $params->{history_sequence}, |
155
|
0
|
|
|
|
|
0
|
sequence_select => $sequence_select |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
) |
158
|
|
|
|
|
|
|
); |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub init_mysql_generators { |
162
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $params ) = @_; |
163
|
0
|
|
|
|
|
0
|
my $generator = Workflow::Persister::DBI::AutoGeneratedId->new( |
164
|
|
|
|
|
|
|
{ from_handle => 'database', |
165
|
|
|
|
|
|
|
handle_property => 'mysql_insertid', |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
); |
168
|
0
|
|
|
|
|
0
|
return ( $generator, $generator ); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub init_sqlite_generators { |
172
|
1
|
|
|
1
|
1
|
2
|
my ( $self, $params ) = @_; |
173
|
1
|
|
|
|
|
9
|
my $generator = Workflow::Persister::DBI::AutoGeneratedId->new( |
174
|
|
|
|
|
|
|
{ func_property => 'last_insert_rowid' } ); |
175
|
1
|
|
|
|
|
4
|
return ( $generator, $generator ); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub assign_tables { |
179
|
14
|
|
|
14
|
1
|
44
|
my ( $self, $params ) = @_; |
180
|
14
|
|
50
|
|
|
97
|
my $wf_table = $params->{workflow_table} || 'workflow'; |
181
|
14
|
|
50
|
|
|
85
|
my $hist_table = $params->{history_table} || 'workflow_history'; |
182
|
14
|
|
|
|
|
74
|
$self->workflow_table($wf_table); |
183
|
14
|
|
|
|
|
209
|
$self->history_table($hist_table); |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
######################################## |
187
|
|
|
|
|
|
|
# PERSISTENCE IMPLEMENTATION |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub create_workflow { |
190
|
19
|
|
|
19
|
1
|
65
|
my ( $self, $wf ) = @_; |
191
|
|
|
|
|
|
|
|
192
|
19
|
|
|
|
|
90
|
$self->_init_fields(); |
193
|
19
|
|
|
|
|
650
|
my @wf_fields = @{ $self->_wf_fields }; |
|
19
|
|
|
|
|
115
|
|
194
|
19
|
|
|
|
|
271
|
my @fields = @wf_fields[ 1, 2, 3 ]; |
195
|
19
|
|
|
|
|
139
|
my @values = ( |
196
|
|
|
|
|
|
|
$wf->type, |
197
|
|
|
|
|
|
|
$wf->state, |
198
|
|
|
|
|
|
|
DateTime->now( time_zone => $wf->time_zone() ) |
199
|
|
|
|
|
|
|
->strftime( $self->date_format() ), |
200
|
|
|
|
|
|
|
); |
201
|
19
|
|
|
|
|
13133
|
my $dbh = $self->handle; |
202
|
|
|
|
|
|
|
|
203
|
19
|
|
|
|
|
290
|
my $id = $self->workflow_id_generator->pre_fetch_id($dbh); |
204
|
19
|
100
|
|
|
|
81
|
if ($id) { |
205
|
18
|
|
|
|
|
46
|
push @fields, $wf_fields[0]; |
206
|
18
|
|
|
|
|
48
|
push @values, $id; |
207
|
18
|
|
|
|
|
97
|
$self->log->debug("Got ID from pre_fetch_id: $id"); |
208
|
|
|
|
|
|
|
} |
209
|
19
|
|
|
|
|
5439
|
my $sql = 'INSERT INTO %s ( %s ) VALUES ( %s )'; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
$sql = sprintf $sql, |
212
|
|
|
|
|
|
|
$self->handle->quote_identifier( $self->workflow_table ), |
213
|
|
|
|
|
|
|
join( ', ', @fields ), |
214
|
19
|
|
|
|
|
96
|
join( ', ', map {'?'} @values ); |
|
75
|
|
|
|
|
1198
|
|
215
|
|
|
|
|
|
|
|
216
|
19
|
100
|
|
|
|
99
|
if ( $self->log->is_debug ) { |
217
|
16
|
|
|
|
|
163
|
$self->log->debug("Will use SQL: $sql"); |
218
|
16
|
|
|
|
|
5578
|
$self->log->debug( "Will use parameters: ", join ', ', @values ); |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
19
|
|
|
|
|
5599
|
my ($sth); |
222
|
|
|
|
|
|
|
|
223
|
19
|
|
|
|
|
59
|
local $EVAL_ERROR = undef; |
224
|
19
|
|
|
|
|
39
|
eval { |
225
|
19
|
|
|
|
|
166
|
$sth = $dbh->prepare($sql); |
226
|
19
|
|
|
|
|
4232
|
$sth->execute(@values); |
227
|
|
|
|
|
|
|
}; |
228
|
19
|
50
|
|
|
|
3934
|
if ($EVAL_ERROR) { |
229
|
0
|
|
|
|
|
0
|
persist_error "Failed to create workflow: $EVAL_ERROR"; |
230
|
|
|
|
|
|
|
} |
231
|
19
|
100
|
|
|
|
65
|
unless ($id) { |
232
|
1
|
|
|
|
|
8
|
$id = $self->workflow_id_generator->post_fetch_id( $dbh, $sth ); |
233
|
1
|
50
|
|
|
|
4
|
unless ($id) { |
234
|
0
|
|
|
|
|
0
|
persist_error "No ID found using generator '", |
235
|
|
|
|
|
|
|
ref( $self->workflow_id_generator ), "'"; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
} |
238
|
19
|
|
|
|
|
157
|
$sth->finish; |
239
|
|
|
|
|
|
|
|
240
|
19
|
|
|
|
|
569
|
$wf->id($id); |
241
|
19
|
|
|
|
|
241
|
return $id; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub fetch_workflow { |
245
|
6
|
|
|
6
|
1
|
18
|
my ( $self, $wf_id ) = @_; |
246
|
6
|
|
|
|
|
21
|
$self->_init_fields(); |
247
|
6
|
|
|
|
|
62
|
my $sql = q{SELECT %s, %s FROM %s WHERE %s = ?}; |
248
|
6
|
|
|
|
|
15
|
my @wf_fields = @{ $self->_wf_fields }; |
|
6
|
|
|
|
|
17
|
|
249
|
6
|
|
|
|
|
80
|
$sql = sprintf $sql, |
250
|
|
|
|
|
|
|
$wf_fields[2], $wf_fields[3], |
251
|
|
|
|
|
|
|
$self->handle->quote_identifier( $self->workflow_table ), |
252
|
|
|
|
|
|
|
$wf_fields[0]; |
253
|
|
|
|
|
|
|
|
254
|
6
|
50
|
|
|
|
345
|
if ( $self->log->is_debug ) { |
255
|
6
|
|
|
|
|
52
|
$self->log->debug("Will use SQL: $sql"); |
256
|
6
|
|
|
|
|
2380
|
$self->log->debug("Will use parameters: $wf_id"); |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
6
|
|
|
|
|
2239
|
my ($sth); |
260
|
|
|
|
|
|
|
|
261
|
6
|
|
|
|
|
15
|
local $EVAL_ERROR = undef; |
262
|
6
|
|
|
|
|
13
|
eval { |
263
|
6
|
|
|
|
|
41
|
$sth = $self->handle->prepare($sql); |
264
|
6
|
|
|
|
|
1172
|
$sth->execute($wf_id); |
265
|
|
|
|
|
|
|
}; |
266
|
6
|
50
|
|
|
|
688
|
if ($EVAL_ERROR) { |
267
|
0
|
|
|
|
|
0
|
persist_error "Cannot fetch workflow: $EVAL_ERROR"; |
268
|
|
|
|
|
|
|
} |
269
|
6
|
|
|
|
|
82
|
my $row = $sth->fetchrow_arrayref; |
270
|
6
|
100
|
|
|
|
324
|
return unless ($row); |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
return { |
273
|
4
|
|
|
|
|
24
|
state => $row->[0], |
274
|
|
|
|
|
|
|
last_update => $self->parser->parse_datetime( $row->[1] ), |
275
|
|
|
|
|
|
|
}; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub update_workflow { |
279
|
52
|
|
|
52
|
1
|
114
|
my ( $self, $wf ) = @_; |
280
|
52
|
|
|
|
|
157
|
$self->_init_fields(); |
281
|
52
|
|
|
|
|
527
|
my $sql = q{UPDATE %s SET %s = ?, %s = ? WHERE %s = ?}; |
282
|
52
|
|
|
|
|
106
|
my @wf_fields = @{ $self->_wf_fields }; |
|
52
|
|
|
|
|
134
|
|
283
|
52
|
|
|
|
|
583
|
$sql = sprintf $sql, |
284
|
|
|
|
|
|
|
$self->handle->quote_identifier( $self->workflow_table ), |
285
|
|
|
|
|
|
|
$wf_fields[2], $wf_fields[3], $wf_fields[0]; |
286
|
52
|
|
|
|
|
3089
|
my $update_date = DateTime->now( time_zone => $wf->time_zone() ) |
287
|
|
|
|
|
|
|
->strftime( $self->date_format() ); |
288
|
|
|
|
|
|
|
|
289
|
52
|
100
|
|
|
|
29930
|
if ( $self->log->is_debug ) { |
290
|
18
|
|
|
|
|
225
|
$self->log->debug("Will use SQL: $sql"); |
291
|
18
|
|
|
|
|
6615
|
$self->log->debug( "Will use parameters: ", |
292
|
|
|
|
|
|
|
join ', ', $wf->state, $update_date, $wf->id ); |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
52
|
|
|
|
|
7104
|
my ($sth); |
296
|
|
|
|
|
|
|
|
297
|
52
|
|
|
|
|
124
|
local $EVAL_ERROR = undef; |
298
|
52
|
|
|
|
|
104
|
eval { |
299
|
52
|
|
|
|
|
153
|
$sth = $self->handle->prepare($sql); |
300
|
52
|
|
|
|
|
8342
|
$sth->execute( $wf->state, $update_date, $wf->id ); |
301
|
|
|
|
|
|
|
}; |
302
|
52
|
50
|
|
|
|
10341
|
if ($EVAL_ERROR) { |
303
|
0
|
|
|
|
|
0
|
persist_error $EVAL_ERROR; |
304
|
|
|
|
|
|
|
} |
305
|
52
|
|
|
|
|
226
|
$self->log->info( "Workflow ", $wf->id, " updated ok" ); |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub create_history { |
309
|
71
|
|
|
71
|
1
|
168
|
my ( $self, $wf, @history ) = @_; |
310
|
71
|
|
|
|
|
211
|
$self->_init_fields(); |
311
|
|
|
|
|
|
|
|
312
|
71
|
|
|
|
|
798
|
my $dbh = $self->handle; |
313
|
71
|
|
|
|
|
842
|
my $generator = $self->history_id_generator; |
314
|
71
|
|
|
|
|
692
|
foreach my $h (@history) { |
315
|
27
|
50
|
|
|
|
110
|
next if ( $h->is_saved ); |
316
|
27
|
|
|
|
|
132
|
my $id = $generator->pre_fetch_id($dbh); |
317
|
27
|
|
|
|
|
77
|
my @hist_fields = @{ $self->_hist_fields }; |
|
27
|
|
|
|
|
90
|
|
318
|
27
|
|
|
|
|
396
|
my @fields = @hist_fields[ 1 .. 6 ]; |
319
|
27
|
|
|
|
|
102
|
my @values = ( |
320
|
|
|
|
|
|
|
$wf->id, $h->action, $h->description, $h->state, $h->user, |
321
|
|
|
|
|
|
|
$h->date->strftime( $self->date_format() ), |
322
|
|
|
|
|
|
|
); |
323
|
27
|
100
|
|
|
|
3818
|
if ($id) { |
324
|
25
|
|
|
|
|
75
|
push @fields, $hist_fields[0]; |
325
|
25
|
|
|
|
|
72
|
push @values, $id; |
326
|
|
|
|
|
|
|
} |
327
|
27
|
|
|
|
|
67
|
my $sql = 'INSERT INTO %s ( %s ) VALUES ( %s )'; |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
$sql = sprintf $sql, $dbh->quote_identifier( $self->history_table ), |
330
|
27
|
|
|
|
|
152
|
join( ', ', @fields ), join( ', ', map {'?'} @values ); |
|
187
|
|
|
|
|
1518
|
|
331
|
27
|
100
|
|
|
|
137
|
if ( $self->log->is_debug ) { |
332
|
24
|
|
|
|
|
209
|
$self->log->debug("Will use SQL: $sql"); |
333
|
24
|
|
|
|
|
8685
|
$self->log->debug( "Will use parameters: ", join ', ', @values ); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
27
|
|
|
|
|
8265
|
my ($sth); |
337
|
|
|
|
|
|
|
|
338
|
27
|
|
|
|
|
76
|
local $EVAL_ERROR = undef; |
339
|
27
|
|
|
|
|
58
|
eval { |
340
|
27
|
|
|
|
|
168
|
$sth = $dbh->prepare($sql); |
341
|
27
|
|
|
|
|
3731
|
$sth->execute(@values); |
342
|
|
|
|
|
|
|
}; |
343
|
27
|
50
|
|
|
|
4334
|
if ($EVAL_ERROR) { |
344
|
0
|
|
|
|
|
0
|
persist_error $EVAL_ERROR; |
345
|
|
|
|
|
|
|
} |
346
|
27
|
100
|
|
|
|
112
|
unless ($id) { |
347
|
2
|
|
|
|
|
11
|
$id = $self->history_id_generator->post_fetch_id( $dbh, $sth ); |
348
|
2
|
50
|
|
|
|
7
|
unless ($id) { |
349
|
0
|
|
|
|
|
0
|
persist_error "No ID found using generator '", |
350
|
|
|
|
|
|
|
ref( $self->history_id_generator ), "'"; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
27
|
|
|
|
|
146
|
$h->id($id); |
354
|
27
|
|
|
|
|
424
|
$h->set_saved(); |
355
|
27
|
|
|
|
|
95
|
$self->log->info( "Workflow history entry ", $id, " created ok" ); |
356
|
|
|
|
|
|
|
} |
357
|
71
|
|
|
|
|
9381
|
return @history; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub fetch_history { |
361
|
2
|
|
|
2
|
1
|
5
|
my ( $self, $wf ) = @_; |
362
|
2
|
|
|
|
|
7
|
$self->_init_fields(); |
363
|
|
|
|
|
|
|
|
364
|
2
|
|
|
|
|
24
|
my $sql = qq{SELECT %s FROM %s WHERE %s = ? ORDER BY %s DESC}; |
365
|
2
|
|
|
|
|
19
|
my @hist_fields = @{ $self->_hist_fields }; |
|
2
|
|
|
|
|
12
|
|
366
|
2
|
|
|
|
|
35
|
my $history_fields = join ', ', @hist_fields; |
367
|
2
|
|
|
|
|
9
|
$sql = sprintf $sql, $history_fields, |
368
|
|
|
|
|
|
|
$self->handle->quote_identifier($self->history_table), |
369
|
|
|
|
|
|
|
$hist_fields[1], $hist_fields[6]; |
370
|
|
|
|
|
|
|
|
371
|
2
|
50
|
|
|
|
118
|
if ( $self->log->is_debug ) { |
372
|
2
|
|
|
|
|
25
|
$self->log->debug("Will use SQL: $sql"); |
373
|
2
|
|
|
|
|
700
|
$self->log->debug( "Will use parameters: ", $wf->id ); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
2
|
|
|
|
|
758
|
my ($sth); |
377
|
|
|
|
|
|
|
|
378
|
2
|
|
|
|
|
7
|
local $EVAL_ERROR = undef; |
379
|
2
|
|
|
|
|
7
|
eval { |
380
|
2
|
|
|
|
|
9
|
$sth = $self->handle->prepare($sql); |
381
|
2
|
|
|
|
|
426
|
$sth->execute( $wf->id ); |
382
|
|
|
|
|
|
|
}; |
383
|
2
|
50
|
|
|
|
266
|
if ($EVAL_ERROR) { |
384
|
0
|
|
|
|
|
0
|
$self->log->error("Caught error fetching workflow history: $EVAL_ERROR"); |
385
|
0
|
|
|
|
|
0
|
persist_error $EVAL_ERROR; |
386
|
|
|
|
|
|
|
} |
387
|
2
|
|
|
|
|
9
|
$self->log->debug("Prepared and executed ok"); |
388
|
|
|
|
|
|
|
|
389
|
2
|
|
|
|
|
680
|
my @history = (); |
390
|
2
|
|
|
|
|
30
|
while ( my $row = $sth->fetchrow_arrayref ) { |
391
|
2
|
|
|
|
|
256
|
$self->log->debug("Fetched history object '$row->[0]'"); |
392
|
|
|
|
|
|
|
|
393
|
2
|
|
|
|
|
742
|
my $hist = Workflow::History->new({ |
394
|
|
|
|
|
|
|
id => $row->[0], |
395
|
|
|
|
|
|
|
workflow_id => $row->[1], |
396
|
|
|
|
|
|
|
action => $row->[2], |
397
|
|
|
|
|
|
|
description => $row->[3], |
398
|
|
|
|
|
|
|
state => $row->[4], |
399
|
|
|
|
|
|
|
user => $row->[5], |
400
|
|
|
|
|
|
|
date => $self->parser->parse_datetime( $row->[6] ), |
401
|
|
|
|
|
|
|
}); |
402
|
2
|
|
|
|
|
14
|
$hist->set_saved(); |
403
|
2
|
|
|
|
|
11
|
push @history, $hist; |
404
|
|
|
|
|
|
|
} |
405
|
2
|
|
|
|
|
98
|
$sth->finish; |
406
|
2
|
|
|
|
|
75
|
return @history; |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub commit_transaction { |
410
|
70
|
|
|
70
|
1
|
141
|
my ( $self, $wf ) = @_; |
411
|
70
|
100
|
|
|
|
176
|
if ( not $self->autocommit() ) { |
412
|
2
|
|
|
|
|
24
|
local $EVAL_ERROR = undef; |
413
|
2
|
|
|
|
|
3
|
eval { $self->handle->commit(); }; |
|
2
|
|
|
|
|
5
|
|
414
|
2
|
50
|
|
|
|
35579
|
if ($EVAL_ERROR) { |
415
|
0
|
|
|
|
|
0
|
$self->log->error("Caught error committing transaction: $EVAL_ERROR"); |
416
|
0
|
|
|
|
|
0
|
persist_error $EVAL_ERROR; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub rollback_transaction { |
422
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $wf ) = @_; |
423
|
0
|
0
|
|
|
|
0
|
if ( not $self->autocommit() ) { |
424
|
0
|
|
|
|
|
0
|
local $EVAL_ERROR = undef; |
425
|
0
|
|
|
|
|
0
|
eval { $self->handle->rollback(); }; |
|
0
|
|
|
|
|
0
|
|
426
|
0
|
0
|
|
|
|
0
|
if ($EVAL_ERROR) { |
427
|
0
|
|
|
|
|
0
|
$self->log->error("Caught error rolling back transaction: $EVAL_ERROR"); |
428
|
0
|
|
|
|
|
0
|
persist_error $EVAL_ERROR; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
########## |
434
|
|
|
|
|
|
|
# FIELDS |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# Allow subclasses to override the fieldnames |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
sub _init_fields { |
439
|
150
|
|
|
150
|
|
244
|
my ($self) = @_; |
440
|
150
|
100
|
|
|
|
389
|
unless ( $self->_wf_fields ) { |
441
|
|
|
|
|
|
|
$self->_wf_fields( |
442
|
|
|
|
|
|
|
[ |
443
|
|
|
|
|
|
|
map { |
444
|
13
|
|
|
|
|
217
|
$self->handle->quote_identifier($_) |
|
52
|
|
|
|
|
4232
|
|
445
|
|
|
|
|
|
|
} $self->get_workflow_fields() |
446
|
|
|
|
|
|
|
]); |
447
|
|
|
|
|
|
|
} |
448
|
150
|
100
|
|
|
|
2256
|
unless ( $self->_hist_fields ) { |
449
|
|
|
|
|
|
|
$self->_hist_fields( |
450
|
|
|
|
|
|
|
[ |
451
|
|
|
|
|
|
|
map { |
452
|
13
|
|
|
|
|
270
|
$self->handle->quote_identifier($_) |
|
91
|
|
|
|
|
2380
|
|
453
|
|
|
|
|
|
|
} $self->get_history_fields() |
454
|
|
|
|
|
|
|
]); |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
sub get_workflow_fields { |
459
|
12
|
|
|
12
|
1
|
41
|
return qw( workflow_id type state last_update ); |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
sub get_history_fields { |
463
|
12
|
|
|
12
|
1
|
58
|
return qw( workflow_hist_id workflow_id |
464
|
|
|
|
|
|
|
action description state |
465
|
|
|
|
|
|
|
workflow_user history_date ); |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
1; |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
__END__ |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=pod |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=head1 NAME |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
Workflow::Persister::DBI - Persist workflow and history to DBI database |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=head1 VERSION |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
This documentation describes version 1.62 of this package |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=head1 SYNOPSIS |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
<persister name="MainDatabase" |
485
|
|
|
|
|
|
|
class="Workflow::Persister::DBI" |
486
|
|
|
|
|
|
|
dsn="DBI:mysql:database=workflows" |
487
|
|
|
|
|
|
|
user="wf" |
488
|
|
|
|
|
|
|
password="mypass"/> |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
<persister name="BackupDatabase" |
491
|
|
|
|
|
|
|
class="Workflow::Persister::DBI" |
492
|
|
|
|
|
|
|
dsn="DBI:Pg:dbname=workflows" |
493
|
|
|
|
|
|
|
user="wf" |
494
|
|
|
|
|
|
|
password="mypass" |
495
|
|
|
|
|
|
|
date_format="%Y-%m-%d %H:%M" |
496
|
|
|
|
|
|
|
autocommit="0" |
497
|
|
|
|
|
|
|
workflow_table="wf" |
498
|
|
|
|
|
|
|
workflow_sequence="wf_seq" |
499
|
|
|
|
|
|
|
history_table="wf_history" |
500
|
|
|
|
|
|
|
history_sequence="wf_history_seq"/> |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
<persister name="OtherDatabase" |
503
|
|
|
|
|
|
|
class="My::Persister::DBHFromElsewhere" |
504
|
|
|
|
|
|
|
driver="mysql" |
505
|
|
|
|
|
|
|
/> |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=head1 DESCRIPTION |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
Main persistence class for storing the workflow and workflow history |
511
|
|
|
|
|
|
|
records to a DBI-accessible datasource. |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=head2 Subclassing: Getting handle from elsewhere |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
A common need to create a subclass is to use a database handle created |
516
|
|
|
|
|
|
|
with other means. For instance, OpenInteract has a central |
517
|
|
|
|
|
|
|
configuration file for defining datasources, and the datasource will |
518
|
|
|
|
|
|
|
be available in a predictable manner. So we can create a subclass to |
519
|
|
|
|
|
|
|
provide the database handle on demand from the C<CTX> object available |
520
|
|
|
|
|
|
|
from everywhere. A sample implementation is below. (Note that in real |
521
|
|
|
|
|
|
|
life we would just use SPOPS for this, but it is still a good |
522
|
|
|
|
|
|
|
example.) |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
package Workflow::Persister::DBI::OpenInteractHandle; |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
use strict; |
527
|
|
|
|
|
|
|
use base qw( Workflow::Persister::DBI ); |
528
|
|
|
|
|
|
|
use OpenInteract2::Context qw( CTX ); |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
my @FIELDS = qw( datasource_name ); |
531
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors( @FIELDS ); |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
# override parent method, assuming that we set the 'datasource' |
534
|
|
|
|
|
|
|
# parameter in the persister declaration |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
sub init { |
537
|
|
|
|
|
|
|
my ( $self, $params ) = @_; |
538
|
|
|
|
|
|
|
$self->datasource_name( $params->{datasource} ); |
539
|
|
|
|
|
|
|
my $ds_config = CTX->lookup_datasource_config( $self->datasource_name ); |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# delegate the other assignment tasks to the parent class |
542
|
|
|
|
|
|
|
$params->{driver} = $ds_config->{driver_name}; |
543
|
|
|
|
|
|
|
$self->SUPER::init( $params ); |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
# suppress the parent from trying to connect to the database |
547
|
|
|
|
|
|
|
sub create_handle { return undef; } |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
sub handle { |
550
|
|
|
|
|
|
|
my ( $self ) = @_; |
551
|
|
|
|
|
|
|
return CTX->datasource( $self->datasource_name ); |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=head2 Subclassing: Changing fieldnames |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
Earlier versions of Workflow used the field 'user' to record in the |
557
|
|
|
|
|
|
|
history the user making a state change or comment. Unfortunately |
558
|
|
|
|
|
|
|
'user' is a reserved word in our favorite database, |
559
|
|
|
|
|
|
|
PostgreSQL. (Oops.) So in addition to changing the field to an |
560
|
|
|
|
|
|
|
assuredly-unreserved word (workflow_user), we made the fieldnames |
561
|
|
|
|
|
|
|
customizable by subclasses. |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
Just override either or both of the methods: |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
=head3 get_workflow_fields() |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
Return list of fields in this order: |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
workflow_id, type, state, last_update |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=head3 get_history_fields() |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
Return list of fields in this order: |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
workflow_hist_id, workflow_id, action, description, |
576
|
|
|
|
|
|
|
state, workflow_user, history_date |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
Note that we may cache the results, so don't try and do anything weird |
579
|
|
|
|
|
|
|
like change the fieldnames based on the workflow user or something... |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=head1 METHODS |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head2 Public Methods |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
All public methods are inherited from L<Workflow::Persister>. |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=head2 Private Methods |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=head3 init( \%params ) |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
Initializes the the instance by setting the connection parameters |
592
|
|
|
|
|
|
|
and calling C<create_handle>. You are only required to provide 'dsn', |
593
|
|
|
|
|
|
|
which is the full DBI DSN you normally use as the first argument |
594
|
|
|
|
|
|
|
to C<connect()>. |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
You can set these parameters in your persister configuration file and |
597
|
|
|
|
|
|
|
they will be passed to init. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
You may also use: |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=over 4 |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
=item B<user> |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
Name of user to login with. |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
=item B<password> |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
Password for C<user> to login with. |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=item B<date_format> |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
Date format to use when working with the database. Accepts a format string |
614
|
|
|
|
|
|
|
that can be processed by the DateTime module. See |
615
|
|
|
|
|
|
|
L<http://search.cpan.org/~drolsky/DateTime-0.39/lib/DateTime.pm#strftime_Specifiers> |
616
|
|
|
|
|
|
|
for the format options. |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
The default is '%Y-%m-%d %H:%M' for backward compatibility. |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=item B<autocommit> |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
0 or 1 to turn autocommit off or on for the database handle. |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
Setting autocommit to off will run Workflow with transactions. If there is |
625
|
|
|
|
|
|
|
a failure somewhere and the persister supports it, Workflow will attempt |
626
|
|
|
|
|
|
|
to roll back all database activity in the current transaction. |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
If you turn autocommit off, you must still |
629
|
|
|
|
|
|
|
commit transactions for L<Workflow::Persister::DBI::ExtraData> yourself. Also, |
630
|
|
|
|
|
|
|
if you are sharing the database handle, you must be careful to not pass control |
631
|
|
|
|
|
|
|
to the workflow engine with pending transactions as they will be committed if |
632
|
|
|
|
|
|
|
the workflow actions are successful. |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
The default autocommit value for the database handle is on. |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
=item B<workflow_table> |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
Table to use for persisting workflow. Default is 'workflow'. |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
=item B<history_table> |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
Table to use for persisting workflow history. Default is |
643
|
|
|
|
|
|
|
'workflow_history'. |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
=back |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
You may also use parameters for the different types of ID |
648
|
|
|
|
|
|
|
generators. See below under the C<init_*_generator> for the necessary |
649
|
|
|
|
|
|
|
parameters for your database. |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
In addition to creating a database handle we parse the C<dsn> to see |
652
|
|
|
|
|
|
|
what driver we are using to determine how to generate IDs. We have the |
653
|
|
|
|
|
|
|
ability to use automatically generated IDs for PostgreSQL, MySQL, and |
654
|
|
|
|
|
|
|
SQLite. If your database is not included a randomly generated ID will |
655
|
|
|
|
|
|
|
be used. (Default length of 8 characters, which you can modify with a |
656
|
|
|
|
|
|
|
C<id_length> parameter.) |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
You can also create your own adapter for a different type of |
659
|
|
|
|
|
|
|
database. Just check out the existing |
660
|
|
|
|
|
|
|
L<Workflow::Persister::DBI::AutoGeneratedId> and |
661
|
|
|
|
|
|
|
L<Workflow::Persister::DBI::SequenceId> classes for examples. |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=head3 assign_generators( $driver, \%params ) |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
Given C<$driver> and the persister parameters in C<\%params>, assign |
666
|
|
|
|
|
|
|
the appropriate ID generators for both the workflow and history |
667
|
|
|
|
|
|
|
tables. |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
Returns: nothing, but assigns the object properties |
670
|
|
|
|
|
|
|
C<workflow_id_generator> and C<history_id_generator>. |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=head3 assign_tables( \%params ) |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
Assign the table names from C<\%params> (using 'workflow_table' and |
675
|
|
|
|
|
|
|
'history_table') or use the defaults 'workflow' and 'workflow_history'. |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
Returns: nothing, but assigns the object properties C<workflow_table> |
678
|
|
|
|
|
|
|
and C<history_table>. |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=head3 init_postgres_generators( \%params ) |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
Create ID generators for the workflow and history tables using |
683
|
|
|
|
|
|
|
PostgreSQL sequences. You can specify the sequences used for the |
684
|
|
|
|
|
|
|
workflow and history tables: |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=over 4 |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=item B<workflow_sequence> |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
Sequence for the workflow table. Default: 'workflow_seq' |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=item B<history_sequence> |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
Sequence for the workflow history table. Default: |
695
|
|
|
|
|
|
|
'workflow_history_seq' |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=back |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=head3 init_mysql_generators( \%params ) |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
Create ID generators for the workflow and history tables using |
702
|
|
|
|
|
|
|
the MySQL 'auto_increment' type. No parameters are necessary. |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=head3 init_sqlite_generators( \%params ) |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
Create ID generators for the workflow and history tables using |
707
|
|
|
|
|
|
|
the SQLite implicit increment. No parameters are necessary. |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=head3 init_random_generators( \%params ) |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
Create ID generators for the workflow and history tables using |
712
|
|
|
|
|
|
|
a random set of characters. You can specify: |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=over 4 |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=item B<id_length> |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
Length of character sequence to generate. Default: 8. |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=back |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=head3 init_oracle_generators |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
Create ID generators for the workflow and history tables using |
725
|
|
|
|
|
|
|
the Oracle sequences. No parameters are necessary. |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
=head3 create_handle |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
Creates a database connection using DBI's C<connect> method and returns |
730
|
|
|
|
|
|
|
the resulting database handle. Override this method if you want to set |
731
|
|
|
|
|
|
|
different options than the hard-coded ones, or when you want to use a |
732
|
|
|
|
|
|
|
handle from elsewhere. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
The default implementation hard-codes these database handle settings: |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
$dbh->{RaiseError} = 1; |
737
|
|
|
|
|
|
|
$dbh->{PrintError} = 0; |
738
|
|
|
|
|
|
|
$dbh->{ChopBlanks} = 1; |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=head3 create_workflow |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
Serializes a workflow into the persistance entity configured by our workflow. |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
Takes a single parameter: a workflow object |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
Returns a single value, a id for unique identification of out serialized |
747
|
|
|
|
|
|
|
workflow for possible deserialization. |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
=head3 fetch_workflow |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
Deserializes a workflow from the persistance entity configured by our workflow. |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
Takes a single parameter: the unique id assigned to our workflow upon |
754
|
|
|
|
|
|
|
serialization (see L</create_workflow>). |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Returns a hashref consisting of two keys: |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=over |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=item * state, the workflows current state |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=item * last_update, date indicating last update |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=back |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
=head3 update_workflow |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
Updates a serialized workflow in the persistance entity configured by our |
769
|
|
|
|
|
|
|
workflow. |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
Takes a single parameter: a workflow object |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
Returns: Nothing |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
=head3 create_history |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
Serializes history records associated with a workflow object |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
Takes two parameters: a workflow object and an array of workflow history objects |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
Returns: provided array of workflow history objects upon success |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=head3 fetch_history |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
Deserializes history records associated with a workflow object |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
Takes a single parameter: a workflow object |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
Returns an array of workflow history objects upon success |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=head3 commit_transaction ( $wf ) |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
Commit the transaction for a workflow if autocommit is not enabled. |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
Returns nothing |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=head3 rollback_transaction |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
Rollsback the transaction for a workflow if autocommit is not enabled. |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
Returns nothing |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
=head1 SEE ALSO |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
=over |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=item L<Workflow> |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
=item L<Workflow::Persister> |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
=item L<Workflow::History> |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=item L<DBI> |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=back |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=head1 COPYRIGHT |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
Copyright (c) 2003-2023 Chris Winters. All rights reserved. |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
823
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
Please see the F<LICENSE> |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=head1 AUTHORS |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Please see L<Workflow> |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=cut |