File Coverage

blib/lib/Workflow/Persister/File.pm
Criterion Covered Total %
statement 119 126 94.4
branch 10 20 50.0
condition 2 6 33.3
subroutine 23 23 100.0
pod 8 8 100.0
total 162 183 88.5


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