line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Workflow::Persister::File; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
787
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
76
|
|
4
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
44
|
|
|
2
|
|
|
|
|
57
|
|
5
|
2
|
|
|
2
|
|
12
|
use base qw( Workflow::Persister ); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
258
|
|
6
|
2
|
|
|
2
|
|
15
|
use Data::Dumper qw( Dumper ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
111
|
|
7
|
2
|
|
|
2
|
|
20
|
use File::Spec::Functions qw( catdir catfile ); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
129
|
|
8
|
2
|
|
|
2
|
|
15
|
use Log::Log4perl qw( get_logger ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
62
|
|
9
|
2
|
|
|
2
|
|
142
|
use Workflow::Exception qw( configuration_error persist_error ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
109
|
|
10
|
2
|
|
|
2
|
|
313
|
use Workflow::Persister::RandomId; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
11
|
|
11
|
2
|
|
|
2
|
|
1189
|
use File::Slurp qw(slurp); |
|
2
|
|
|
|
|
24291
|
|
|
2
|
|
|
|
|
140
|
|
12
|
2
|
|
|
2
|
|
19
|
use English qw( -no_match_vars ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
17
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
$Workflow::Persister::File::VERSION = '1.62'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
my @FIELDS = qw( path ); |
17
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(@FIELDS); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub init { |
20
|
2
|
|
|
2
|
1
|
5
|
my ( $self, $params ) = @_; |
21
|
2
|
|
|
|
|
19
|
$self->SUPER::init($params); |
22
|
2
|
50
|
33
|
|
|
1786
|
unless ( $self->use_uuid eq 'yes' || $self->use_random eq 'yes' ) { |
23
|
2
|
|
|
|
|
59
|
$self->use_random('yes'); |
24
|
|
|
|
|
|
|
} |
25
|
2
|
|
|
|
|
39
|
$self->assign_generators($params); |
26
|
2
|
50
|
|
|
|
63
|
unless ( $params->{path} ) { |
27
|
0
|
|
|
|
|
0
|
configuration_error "The file persister must have the 'path' ", |
28
|
|
|
|
|
|
|
"specified in the configuration"; |
29
|
|
|
|
|
|
|
} |
30
|
2
|
50
|
|
|
|
57
|
unless ( -d $params->{path} ) { |
31
|
0
|
|
|
|
|
0
|
configuration_error "The file persister must have a valid directory ", |
32
|
|
|
|
|
|
|
"specified in the 'path' key of the configuration ", |
33
|
|
|
|
|
|
|
"(given: '$params->{path}')"; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
$self->log->info( |
36
|
2
|
|
|
|
|
38
|
"Using path for workflows and histories '$params->{path}'"); |
37
|
2
|
|
|
|
|
699
|
$self->path( $params->{path} ); |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub create_workflow { |
41
|
2
|
|
|
2
|
1
|
6
|
my ( $self, $wf ) = @_; |
42
|
2
|
|
|
|
|
10
|
my $generator = $self->workflow_id_generator; |
43
|
2
|
|
|
|
|
34
|
my $wf_id = $generator->pre_fetch_id(); |
44
|
2
|
|
|
|
|
20
|
$wf->id($wf_id); |
45
|
2
|
|
|
|
|
7
|
$self->log->debug("Generated workflow ID '$wf_id'"); |
46
|
2
|
|
|
|
|
689
|
$self->_serialize_workflow($wf); |
47
|
2
|
|
|
|
|
677
|
my $full_history_path = $self->_get_history_path($wf); |
48
|
|
|
|
|
|
|
## no critic (ProhibitMagicNumbers) |
49
|
2
|
50
|
|
|
|
227
|
mkdir( $full_history_path, 0777 ) |
50
|
|
|
|
|
|
|
|| persist_error "Cannot create history dir '$full_history_path': $!"; |
51
|
|
|
|
|
|
|
|
52
|
2
|
|
|
|
|
15
|
return $wf_id; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub fetch_workflow { |
56
|
4
|
|
|
4
|
1
|
1495
|
my ( $self, $wf_id ) = @_; |
57
|
4
|
|
|
|
|
11
|
my $full_path = $self->_get_workflow_path($wf_id); |
58
|
4
|
|
|
|
|
87
|
$self->log->debug("Checking to see if workflow exists in '$full_path'"); |
59
|
4
|
50
|
|
|
|
1444
|
unless ( -f $full_path ) { |
60
|
0
|
|
|
|
|
0
|
$self->log->error("No file at path '$full_path'"); |
61
|
0
|
|
|
|
|
0
|
persist_error "No workflow with ID '$wf_id' is available"; |
62
|
|
|
|
|
|
|
} |
63
|
4
|
|
|
|
|
36
|
$self->log->debug("File exists, reconstituting workflow"); |
64
|
|
|
|
|
|
|
|
65
|
4
|
|
|
|
|
1366
|
local $EVAL_ERROR = undef; |
66
|
4
|
|
|
|
|
11
|
my $wf_info = eval { $self->constitute_object($full_path) }; |
|
4
|
|
|
|
|
19
|
|
67
|
4
|
50
|
|
|
|
24
|
if ($EVAL_ERROR) { |
68
|
0
|
|
|
|
|
0
|
persist_error "Cannot reconstitute data from file for ", |
69
|
|
|
|
|
|
|
"workflow '$wf_id': $EVAL_ERROR"; |
70
|
|
|
|
|
|
|
} |
71
|
4
|
|
|
|
|
18
|
return $wf_info; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub update_workflow { |
75
|
2
|
|
|
2
|
1
|
6
|
my ( $self, $wf ) = @_; |
76
|
2
|
|
|
|
|
7
|
$self->_serialize_workflow($wf); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub create_history { |
80
|
4
|
|
|
4
|
1
|
10
|
my ( $self, $wf, @history ) = @_; |
81
|
4
|
|
|
|
|
14
|
my $generator = $self->history_id_generator; |
82
|
4
|
|
|
|
|
52
|
my $history_dir = $self->_get_history_path($wf); |
83
|
4
|
|
|
|
|
115
|
$self->log->info("Will use directory '$history_dir' for history"); |
84
|
4
|
|
|
|
|
1508
|
foreach my $history (@history) { |
85
|
3
|
50
|
|
|
|
33
|
if ( $history->is_saved ) { |
86
|
0
|
|
|
|
|
0
|
$self->log->debug("History object saved, skipping..."); |
87
|
0
|
|
|
|
|
0
|
next; |
88
|
|
|
|
|
|
|
} |
89
|
3
|
|
|
|
|
12
|
$self->log->debug("History object unsaved, continuing..."); |
90
|
3
|
|
|
|
|
1041
|
my $history_id = $generator->pre_fetch_id(); |
91
|
3
|
|
|
|
|
15
|
$history->id($history_id); |
92
|
3
|
|
|
|
|
50
|
my $history_file = catfile( $history_dir, $history_id ); |
93
|
3
|
|
|
|
|
22
|
$self->serialize_object( $history_file, $history ); |
94
|
3
|
|
|
|
|
1084
|
$self->log->info("Created history object '$history_id' ok"); |
95
|
3
|
|
|
|
|
1017
|
$history->set_saved(); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub fetch_history { |
100
|
2
|
|
|
2
|
1
|
8
|
my ( $self, $wf ) = @_; |
101
|
2
|
|
|
|
|
5
|
my $history_dir = $self->_get_history_path($wf); |
102
|
2
|
|
|
|
|
52
|
$self->log->debug("Trying to read history files from dir '$history_dir'"); |
103
|
2
|
50
|
|
|
|
773
|
opendir( my $hist, $history_dir ) |
104
|
|
|
|
|
|
|
|| persist_error "Cannot read history from '$history_dir': $!"; |
105
|
7
|
|
|
|
|
115
|
my @history_files = grep { -f $_ } |
106
|
2
|
|
|
|
|
76
|
map { catfile( $history_dir, $_ ) } readdir $hist; |
|
7
|
|
|
|
|
39
|
|
107
|
2
|
|
|
|
|
47
|
closedir $hist; |
108
|
2
|
|
|
|
|
11
|
my @histories = (); |
109
|
|
|
|
|
|
|
|
110
|
2
|
|
|
|
|
6
|
foreach my $history_file (@history_files) { |
111
|
3
|
|
|
|
|
13
|
$self->log->debug("Reading history from file '$history_file'"); |
112
|
3
|
|
|
|
|
1053
|
my $history = $self->constitute_object($history_file); |
113
|
3
|
|
|
|
|
21
|
$history->set_saved(); |
114
|
3
|
|
|
|
|
10
|
push @histories, $history; |
115
|
|
|
|
|
|
|
} |
116
|
2
|
|
|
|
|
13
|
return @histories; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _serialize_workflow { |
120
|
4
|
|
|
4
|
|
9
|
my ( $self, $wf ) = @_; |
121
|
4
|
|
|
|
|
9
|
local $Data::Dumper::Indent = 1; |
122
|
4
|
|
|
|
|
11
|
my $full_path = $self->_get_workflow_path( $wf->id ); |
123
|
4
|
|
|
|
|
99
|
$self->log->debug("Trying to write workflow to '$full_path'"); |
124
|
4
|
|
|
|
|
1375
|
my %wf_info = ( |
125
|
|
|
|
|
|
|
id => $wf->id, |
126
|
|
|
|
|
|
|
state => $wf->state, |
127
|
|
|
|
|
|
|
last_update => $wf->last_update, |
128
|
|
|
|
|
|
|
type => $wf->type, |
129
|
|
|
|
|
|
|
context => $wf->context, |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
); |
132
|
4
|
|
|
|
|
18
|
$self->serialize_object( $full_path, \%wf_info ); |
133
|
4
|
|
|
|
|
1588
|
$self->log->debug("Wrote workflow ok"); |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub serialize_object { |
137
|
9
|
|
|
9
|
1
|
131
|
my ( $self, $path, $object ) = @_; |
138
|
9
|
|
|
|
|
23
|
$self->log->info( "Trying to save object of type '", |
139
|
|
|
|
|
|
|
ref($object), "' ", "to path '$path'" ); |
140
|
9
|
50
|
|
|
|
3841
|
open( THINGY, '>', $path ) |
141
|
|
|
|
|
|
|
|| persist_error "Cannot write to '$path': $!"; |
142
|
9
|
|
33
|
|
|
57
|
print THINGY Dumper($object) |
143
|
|
|
|
|
|
|
|| persist_error "Error writing to '$path': $!"; |
144
|
9
|
50
|
|
|
|
9597
|
close(THINGY) || persist_error "Cannot close '$path': $!"; |
145
|
9
|
|
|
|
|
53
|
$self->log->debug("Wrote object to file ok"); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub constitute_object { |
149
|
9
|
|
|
9
|
1
|
816
|
my ( $self, $object_path ) = @_; |
150
|
|
|
|
|
|
|
|
151
|
9
|
|
|
|
|
33
|
my $content = slurp($object_path); |
152
|
|
|
|
|
|
|
|
153
|
2
|
|
|
2
|
|
3028
|
no strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
390
|
|
154
|
9
|
|
|
|
|
1282
|
local $EVAL_ERROR = undef; |
155
|
9
|
|
|
|
|
7620
|
my $object = eval $content; |
156
|
9
|
50
|
|
|
|
54
|
croak $EVAL_ERROR if ($EVAL_ERROR); |
157
|
9
|
|
|
|
|
34
|
return $object; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub _get_workflow_path { |
162
|
8
|
|
|
8
|
|
56
|
my ( $self, $wf_id ) = @_; |
163
|
8
|
|
|
|
|
24
|
$self->log->info( "Creating workflow file from '", |
164
|
|
|
|
|
|
|
$self->path, "' ", "and ID '$wf_id'" ); |
165
|
8
|
|
|
|
|
2969
|
return catfile( $self->path, $wf_id . '_workflow' ); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub _get_history_path { |
169
|
8
|
|
|
8
|
|
20
|
my ( $self, $wf ) = @_; |
170
|
8
|
|
|
|
|
19
|
return catdir( $self->path, $wf->id . '_history' ); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
1; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
__END__ |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=pod |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head1 NAME |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Workflow::Persister::File - Persist workflow and history to the filesystem |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 VERSION |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
This documentation describes version 1.62 of this package |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head1 SYNOPSIS |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
<persister name="MainPersister" |
190
|
|
|
|
|
|
|
class="Workflow::Persister::File" |
191
|
|
|
|
|
|
|
path="/home/workflow/storage"/> |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head1 DESCRIPTION |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Main persistence class for storing the workflow and workflow history |
196
|
|
|
|
|
|
|
records to a filesystem for later retrieval. Data are stored in |
197
|
|
|
|
|
|
|
serialized Perl data structure files. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head2 METHODS |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head3 constitute_object |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
This method deserializes an object. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
Takes a single parameter of an filesystem path pointing to an object |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Returns the re-instantiated object or dies. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=head3 create_history |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
Serializes history records associated with a workflow object |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Takes two parameters: a workflow object and an array of workflow history objects |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
Returns: provided array of workflow history objects upon success |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=head3 create_workflow |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Serializes a workflow into the persistance entity configured by our workflow. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
Takes a single parameter: a workflow object |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
Returns a single value, a id for unique identification of out serialized |
224
|
|
|
|
|
|
|
workflow for possible deserialization. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=head3 fetch_history |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Deserializes history records associated with a workflow object |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Takes a single parameter: a workflow object |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Returns an array of workflow history objects upon success |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head3 fetch_workflow |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Deserializes a workflow from the persistance entity configured by our workflow. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Takes a single parameter: the unique id assigned to our workflow upon |
239
|
|
|
|
|
|
|
serialization (see L</create_workflow>). |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
Returns a hashref consisting of two keys: |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=over |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=item * state, the workflows current state |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=item * last_update, date indicating last update |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=back |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=head3 init ( \%params ) |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
Method to initialize the persister object. Sets up the configured generators |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Throws a L<Workflow::Exception> if a valid filesystem path is not provided with |
256
|
|
|
|
|
|
|
the parameters. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head3 serialize_object |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
Method that writes a given object to a given path. |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Takes two parameters: path (a filesystem path) and an object |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
Throws L<Workflow::Exception> if unable to serialize the given object to the |
265
|
|
|
|
|
|
|
given path. |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Returns: Nothing |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=head3 update_workflow |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Updates a serialized workflow in the persistance entity configured by our |
272
|
|
|
|
|
|
|
workflow. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
Takes a single parameter: a workflow object |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
Returns: Nothing |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head1 TODO |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=over |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=item * refactor L</constitute_object>, no checks are made on filesystem prior |
283
|
|
|
|
|
|
|
to deserialization attempt. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=back |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=head1 SEE ALSO |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=over |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
=item * L<Workflow::Persister> |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=back |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head1 COPYRIGHT |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
Copyright (c) 2003-2023 Chris Winters. All rights reserved. |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
300
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
Please see the F<LICENSE> |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=head1 AUTHORS |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
Please see L<Workflow> |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=cut |