Ivan Paponov

Let's make some code. (Check my previous post for flow chart).

Let's use quite simple straightforward approach, and then modify it with some design patterns.

General idea: We will have simple request object. (We wouldn't care how it's populated with data, let's assume that we have some collection object, that gathers requests from database and creates objects). Request will have following properties: id, description, state. We must be able to change states and perform some actions during that state changes.

I'm using v5.10 & Mouse.

Here is the Request class

package Request;
use v5.10;
use Mouse;

has 'id' => (
    is => 'rw',
    isa => 'Int'
);

has 'description' => (
    is => 'rw',
    isa => 'Str'
);

# list of available states stored in arrayRef
has 'states' => (
    is => 'rw',
    isa => 'ArrayRef',
    default => sub { 
        ['Submitted', 'Accepted', 'Rejected', 'Assigned', 'Complete'] 
    }
);

# here we define our flow,
# key is 'current' state
# value - where can we go from current state
has 'state_flow' => (
    is => 'rw',
    isa => 'HashRef',
    default => sub {
        {
            'Submitted' => ['Accepted', 'Rejected'],
            'Accepted' => ['Assigned'],
            'Assigned' => ['Complete']
        }
    }
);

# list of actions that need to be executed on state change
# it's just simple text there, for simplicity
has 'state_actions' => (
    is => 'rw',
    isa => 'HashRef',
    default => sub {
        {
            'Submitted' => 'Email to manager about new request',
            'Rejected' => 'Email to requester about rejection',
            'Accepted' => 'Email to all developers about new bug',
            'Complete' => 'Email to requester about completion'
        }
    }
);

# state property
# has trigger - which calls action on state change
# also has default value
# we force $self->_stateAction call here
# because default value won't call trigger
has 'state' => (
    is => 'rw',
    isa => 'Str',
    default => sub {
        my $self = shift;
        $self->_stateAction('Submitted');
        return 'Submitted';
    },
    trigger => \&_stateAction,
);

# simple output
# should be nice html here
sub show
{
    my $self = shift;
    say 'Request Id: '.$self->id;
    say 'Description: '.$self->description;
    say '';
}

# list of available 'new' states in 'current' state
# should be buttons - which user can click and change state
# we will emulate this user activity simply by calling setter for state property
# $request->state($new_state_name);
sub availableStates
{
    my $self = shift;
    say 'Current State: '.$self->state;
    my @states = @{$self->state_flow->{$self->state}};
    say "Available States: @states";
    say '';
}

# trigger, for state change
# call associated action
sub _stateAction
{
    my ($self, $state, $old_state) = @_;
    say "New state: $state";
    my $action = $self->state_actions->{$state} // '';
    if ($action) {
        say "Action: $action";
    }
    say '';
}

no Mouse;
1;

and sample request.pl script

#!/usr/bin/perl

use v5.10;
use strict;
use warnings;
use Request;

# Sample request
# it should be populated from database actually
my $request = Request->new(
    id => 1,
    description => 'I found bug'
);
$request->show();
$request->availableStates();

# OUTPUT
#
# New state: Submitted
# Action: Email to manager about new request
#
# Request Id: 1
# Description: I found bug
#
# Current State: Submitted
# Available States: Accepted Rejected


# emulate user clicks on state change buttons
$request->state('Accepted');
$request->availableStates();

$request->state('Assigned');
$request->availableStates();

$request->state('Complete');

# OUTPUT
#
# New state: Accepted
# Action: Email to all developers about new bug
# Current State: Accepted
# Available States: Assigned
#
# New state: Assigned
# Current State: Assigned
# Available States: Complete
#
# New state: Complete
# Action: Email to requester about completion

This approach is ok, when you have simple actions and few states. But when your workflow will grow bigger and become more complicated, code will be messy and tricky. But fortunately, it's a common problem, and there is design pattern for it. It is called "state pattern" Check for details: http://perldesignpatterns.com/?StatePattern http://en.wikipedia.org/wiki/State_pattern

So let's do refactoring. Our Request class will look like

package Request;

use v5.10;
use Mouse;
use State::Factory;

has 'id' => (
    is => 'rw',
    isa => 'Int'
);

has 'description' => (
    is => 'rw',
    isa => 'Str'
);

# now we have state object
# not just string
has 'state' => (
    is => 'rw',
    default => sub {
        my $self = shift;
        my $s = State::Factory->create();
        return $s;
    }
);

sub show
{
    my $self = shift;
    say 'Request Id: '.$self->id;
    say 'Description: '.$self->description;
    say '';
}

# since we can't use just $self->state('some state name') for real user emulation
# we will create changeState method, that will ask State Factory for new state
sub changeState
{
    my $self = shift;
    my $state_name = shift;

    say "Changing state to: $state_name";
    my $s = State::Factory->create($state_name);
    $self->state($s);
    say '';
}

no Mouse;
1;

State::Factory

package State::Factory;

use v5.10;
use strict;
use warnings;
use State::Rejected;
use State::Default;

# create state objects
# note that $state->action() will be executed
# because that call is in State::Default::BUILD
sub create
{
    my $class = shift;
    my $state = shift // 'Submitted';

    # handle only one state here - for simplicity
    if ($state eq 'Rejected')
    {
        return State::Rejected->new();
    }
    else
    {
        return State::Default->new(name => $state);
    }
}

1;

State::Default

package State::Default;

use v5.10;
use Mouse;

has 'name' => (
    is => 'rw',
    isa => 'Str'
);

# the same state flow
# as described earlier
has 'state_flow' => (
    is => 'ro',
    isa => 'HashRef',
    default => sub {
        {
            'Submitted' => ['Accepted', 'Rejected'],
            'Accepted' => ['Assigned'],
            'Assigned' => ['Complete']
        }
    }
);

# call action associated with this state
# will be executed - every time we create object
# of course we wouldn't need such behavior in real life
# but it's ok for current sample
sub BUILD
{
    my $self = shift;
    $self->action();
}

sub action
{
    my $self = shift;
    say 'Default Action';
}

# retrieve available 'new' states for 'current' state
sub availableStates
{
    my $self = shift;
    say 'Current State: '.$self->name;
    my @states = @{$self->state_flow->{$self->name}};
    say "Available States: @states";
    say '';
}

no Mouse;
1;

State::Rejected
we won't provide other State::Default child classes here, they are the same

package State::Rejected;

use v5.10;
use Mouse;
extends 'State::Default';

sub BUILD
{
    my $self = shift;
    my $name = $self->name // 'Rejected';
    $self->name($name);
}

sub action
{
    my $self = shift;
    $self->SUPER::action();
    say 'Email to requester about rejection';
}

no Mouse;
1;

request.pl looks almost the same

#!/usr/bin/perl

use v5.10;
use strict;
use warnings;
use Request;

# Sample request
my $request = Request->new(
    id => 1,
    description => 'I found bug'
);
$request->show();
$request->state->availableStates();

# OUTPUT
#
# Default Action
# Request Id: 1
# Description: I found bug
#
# Current State: Submitted
# Available States: Accepted Rejected



# emulate user behavior
$request->changeState('Accepted');
$request->state->availableStates();

# OUTPUT
#
# Changing state to: Accepted
# Default Action
# Current State: Accepted
# Available States: Assigned

$request->changeState('Rejected');

# OUTPUT
#
# Changing state to: Rejected
# Default Action
# Email to requestor about rejection

It looks better now. What should we do next? Let's check CPAN :)

But let's do it in the next post. Stay tuned. Notes and comments are welcome.