$Workflow::Persister::File::VERSION
=
'2.04'
;
my
@FIELDS
=
qw( path )
;
__PACKAGE__->mk_accessors(
@FIELDS
);
sub
init {
my
(
$self
,
$params
) =
@_
;
$self
->SUPER::init(
$params
);
unless
(
$self
->use_uuid eq
'yes'
||
$self
->use_random eq
'yes'
) {
$self
->use_random(
'yes'
);
}
$self
->assign_generators(
$params
);
unless
(
$params
->{path} ) {
configuration_error
"The file persister must have the 'path' "
,
"specified in the configuration"
;
}
unless
( -d
$params
->{path} ) {
configuration_error
"The file persister must have a valid directory "
,
"specified in the 'path' key of the configuration "
,
"(given: '$params->{path}')"
;
}
$self
->
log
->info(
"Using path for workflows and histories '$params->{path}'"
);
$self
->path(
$params
->{path} );
}
sub
create_workflow {
my
(
$self
,
$wf
) =
@_
;
my
$generator
=
$self
->workflow_id_generator;
my
$wf_id
=
$generator
->pre_fetch_id();
$wf
->id(
$wf_id
);
$self
->
log
->debug(
"Generated workflow ID '$wf_id'"
);
$self
->_serialize_workflow(
$wf
);
my
$full_history_path
=
$self
->_get_history_path(
$wf
);
mkdir
(
$full_history_path
, 0777 )
|| persist_error
"Cannot create history dir '$full_history_path': $!"
;
return
$wf_id
;
}
sub
fetch_workflow {
my
(
$self
,
$wf_id
) =
@_
;
my
$full_path
=
$self
->_get_workflow_path(
$wf_id
);
$self
->
log
->debug(
"Checking to see if workflow exists in '$full_path'"
);
unless
( -f
$full_path
) {
$self
->
log
->error(
"No file at path '$full_path'"
);
persist_error
"No workflow with ID '$wf_id' is available"
;
}
$self
->
log
->debug(
"File exists, reconstituting workflow"
);
my
$wf_info
;
try
{
$wf_info
=
$self
->constitute_object(
$full_path
);
}
catch
(
$error
) {
persist_error
"Cannot reconstitute data from file for "
,
"workflow '$wf_id': $error"
;
}
return
$wf_info
;
}
sub
update_workflow {
my
(
$self
,
$wf
) =
@_
;
$self
->_serialize_workflow(
$wf
);
}
sub
create_history {
my
(
$self
,
$wf
,
@history
) =
@_
;
my
$generator
=
$self
->history_id_generator;
my
$history_dir
=
$self
->_get_history_path(
$wf
);
$self
->
log
->info(
"Will use directory '$history_dir' for history"
);
foreach
my
$history
(
@history
) {
if
(
$history
->is_saved ) {
$self
->
log
->debug(
"History object saved, skipping..."
);
next
;
}
$self
->
log
->debug(
"History object unsaved, continuing..."
);
my
$history_id
=
$generator
->pre_fetch_id();
$history
->id(
$history_id
);
my
$history_file
= catfile(
$history_dir
,
$history_id
);
$self
->serialize_object(
$history_file
, {
%$history
} );
$self
->
log
->info(
"Created history object '$history_id' ok"
);
$history
->set_saved();
}
}
sub
fetch_history {
my
(
$self
,
$wf
) =
@_
;
my
$history_dir
=
$self
->_get_history_path(
$wf
);
$self
->
log
->debug(
"Trying to read history files from dir '$history_dir'"
);
opendir
(
my
$hist
,
$history_dir
)
|| persist_error
"Cannot read history from '$history_dir': $!"
;
my
@history_files
=
grep
{ -f
$_
}
map
{ catfile(
$history_dir
,
$_
) }
readdir
$hist
;
closedir
$hist
;
my
@histories
= ();
foreach
my
$history_file
(
@history_files
) {
$self
->
log
->debug(
"Reading history from file '$history_file'"
);
my
$history
=
$self
->constitute_object(
$history_file
);
push
@histories
,
$history
;
}
return
@histories
;
}
sub
_serialize_workflow {
my
(
$self
,
$wf
) =
@_
;
local
$Data::Dumper::Indent
= 1;
my
$full_path
=
$self
->_get_workflow_path(
$wf
->id );
$self
->
log
->debug(
"Trying to write workflow to '$full_path'"
);
my
%wf_info
= (
id
=>
$wf
->id,
state
=>
$wf
->state,
last_update
=>
$wf
->last_update,
type
=>
$wf
->type,
context
=> { %{
$wf
->context->{PARAMS} } },
);
$self
->serialize_object(
$full_path
, \
%wf_info
);
$self
->
log
->debug(
"Wrote workflow ok"
);
}
sub
serialize_object {
my
(
$self
,
$path
,
$object
) =
@_
;
$self
->
log
->info(
"Trying to save object of type '"
,
ref
(
$object
),
"' "
,
"to path '$path'"
);
open
( THINGY,
'>'
,
$path
)
|| persist_error
"Cannot write to '$path': $!"
;
print
THINGY Dumper(
$object
)
|| persist_error
"Error writing to '$path': $!"
;
close
(THINGY) || persist_error
"Cannot close '$path': $!"
;
$self
->
log
->debug(
"Wrote object to file ok"
);
}
sub
constitute_object {
my
(
$self
,
$object_path
) =
@_
;
my
$content
= slurp(
$object_path
);
no
strict;
my
$object
;
my
$error
;
my
$success
=
do
{
local
$@;
my
$rv
=
eval
"\$object = do { $content }; 1;"
;
$error
=
$EVAL_ERROR
;
$rv
;
};
if
(not
$success
) {
die
$error
;
}
return
$object
;
}
sub
_get_workflow_path {
my
(
$self
,
$wf_id
) =
@_
;
$self
->
log
->info(
"Creating workflow file from '"
,
$self
->path,
"' "
,
"and ID '$wf_id'"
);
return
catfile(
$self
->path,
$wf_id
.
'_workflow'
);
}
sub
_get_history_path {
my
(
$self
,
$wf
) =
@_
;
return
catdir(
$self
->path,
$wf
->id .
'_history'
);
}
1;