package Workflow::Persister; # $Id: Persister.pm 317 2007-07-05 05:46:25Z jonasbn $ use strict; use base qw( Workflow::Base ); use Log::Log4perl qw( get_logger ); use Workflow::Exception qw( persist_error ); $Workflow::Persister::VERSION = '1.09'; my @FIELDS = qw( name class use_random use_uuid workflow_id_generator history_id_generator ); __PACKAGE__->mk_accessors( @FIELDS ); sub init { my ( $self, $params ) = @_; my $log = get_logger(); for ( @FIELDS ) { $self->$_( $params->{ $_ } ) if ( $params->{ $_ } ); } unless ( $self->use_random ) { $self->use_random( 'no' ); } unless ( $self->use_uuid ) { $self->use_uuid( 'no' ); } $log->info( "Initializing persister '", $self->name, "'" ); } ######################################## # COMMON GENERATOR ASSIGNMENTS sub assign_generators { my ( $self, $params ) = @_; $params ||= {}; my $log = get_logger(); my ( $wf_gen, $history_gen ); if ( $self->use_uuid eq 'yes' ) { $log->debug( "Assigning UUID generators by request" ); ( $wf_gen, $history_gen ) = $self->init_uuid_generators( $params ); } elsif ( $self->use_random eq 'yes' ) { $log->debug( "Assigning random ID generators by request" ); ( $wf_gen, $history_gen ) = $self->init_random_generators( $params ); } if ( $wf_gen and $history_gen ) { $self->workflow_id_generator( $wf_gen ); $self->history_id_generator( $history_gen ); } } sub init_random_generators { my ( $self, $params ) = @_; my $length = $params->{id_length} || 8; my $generator = Workflow::Persister::RandomId->new({ id_length => $length }); return ( $generator, $generator ); } sub init_uuid_generators { my ( $self, $params ) = @_; my $generator = Workflow::Persister::UUID->new(); return ( $generator, $generator ); } ######################################## # INTERFACE METHODS sub create_workflow { my ( $self, $wf ) = @_; persist_error "Persister '", ref( $self ), "' must implement ", "'create_workflow()'"; } sub update_workflow { my ( $self, $wf ) = @_; persist_error "Persister '", ref( $self ), "' must implement ", "'update_workflow()'"; } sub fetch_workflow { my ( $self, $wf_id ) = @_; persist_error "Persister '", ref( $self ), "' must implement ", "'fetch_workflow()'"; } # This is the only one that isn't required... sub fetch_extra_workflow_data { my ( $self, $wf ) = @_; my $log = get_logger(); $log->info( "Called empty 'fetch_extra_workflow_data()' (ok)" ); $log->debug( "An empty implementation is not an error as you may ", "not need this extra functionality. If you do you ", "should use a perister for this purpose (e.g., ", "Workflow::Persister::DBI::ExtraData) or ", "create your own and just implement this method." ); return; } sub create_history { my ( $self, $wf, @history ) = @_; persist_error "Persister '", ref( $self ), "' must implement ", "'create_history()'"; } sub fetch_history { my ( $self, $wf ) = @_; persist_error "Persister '", ref( $self ), "' must implement ", "'fetch_history()'"; } 1; __END__ =head1 NAME Workflow::Persister - Base class for workflow persistence =head1 SYNOPSIS # Associate a workflow with a persister ... # Declare a persister # Declare a separate persister =head1 DESCRIPTION This is the base class for persisting workflows. It does not implement anything itself but actual implementations should subclass it to ensure they fulfill the contract. The job of a persister is to create, update and fetch the workflow object plus any data associated with the workflow. It also creates and fetches workflow history records. =head1 SUBCLASSING =head2 Methods =head3 create_workflow( $workflow ) Stub that warns that the method should be overwritten in the derived Persister. Since this is a SUPER class. Generate an ID for the workflow, serialize the workflow data (ID and state) and set the ID in the workflow. =head3 update_workflow( $workflow ) Stub that warns that the method should be overwritten in the derived Persister. Since this is a SUPER class. Update the workflow state. =head3 fetch_workflow( $workflow_id ) Stub that warns that the method should be overwritten in the derived Persister. Since this is a SUPER class. Retrieve the workflow data corresponding to C<$workflow_id>. It not found return undef, if found return a hashref with the data. =head3 create_history( $workflow, @history ) Stub that warns that the method should be overwritten in the derived Persister. Since this is a SUPER class. Serialize all objects in C<@history> for later retrieval. =head3 fetch_history( $workflow ) Stub that warns that the method should be overwritten in the derived Persister. Since this is a SUPER class. The derived class method should return a list of L objects. =head3 assign_generators( \%params ) Assigns proper generators based on intialization, see L =head3 fetch_extra_workflow_data ( $workflow ) A stub that warns that the method should be overwritten in the derived Persister. Since this is a SUPER class. =head3 init Method to initialize persister based on configuration. =head3 init_random_generators( \%params ) Initializes random id generators, takes the following named parameters: =over =item * length, of random id to be generated =back Returns two identical random id generator objects in list context. =head3 init_uuid_generators( \%params ) Initializes UUID generators, takes no parameters Returns two identical UUID generator objects in list context. =head1 TODO =over =item * refactor init_random_generators, returns two similar objects? =item * refactor init_uuid_generators, returns two similar objects? =item * refactor init_uuid_generators, takes no parameters, even though we shift parameters in? =back =head1 SEE ALSO L L =head1 COPYRIGHT Copyright (c) 2003-2007 Chris Winters. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Jonas B. Nielsen (jonasbn) Ejonasbn@cpan.orgE is the current maintainer. Chris Winters Echris@cwinters.comE, original author. =cut