Class::Workflow::State::TransitionHash - Implement transition metadata with a

Class-Workflow documentation Contained in the Class-Workflow distribution.

Index

Code Index:

NAME

Top

Class::Workflow::State::TransitionHash - Implement transition metadata with a hash.

SYNOPSIS

Top

	package MyState;
	use Moose;

	with qw/Class::Workflow::State::TransitionHash/;

DESCRIPTION

Top

This is a concrete role that implements transitions, has_transition and has_transitions as required by Class::Workflow::State, and adds add_transitions, remove_transitions, clear_transitions , get_transitions, and get_transition as well.

Transition storage is implemented internally with Set::Object.

This is an additional layer over Class::Workflow::State::TransitionSet that requires all transitions to respond to the name method, but as a bonus allows you to refer to your transitions by name or by value.

METHODS

Top

See Class::Workflow::State::TransitionSet and Class::Workflow::State.

get_transition $name
get_transitions @names

These methods allow you to pass in either a name or an object, and always get back an object (unless the transition by that name does not exist, in which case you get an undefined value).

Class-Workflow documentation Contained in the Class-Workflow distribution. 
#!/usr/bin/perl

package Class::Workflow::State::TransitionHash;
use Moose::Role;

use Carp qw/croak/;

with qw/
	Class::Workflow::State
	Class::Workflow::State::TransitionSet
/;

has transition_hash => (
	isa => "HashRef",
	is  => "rw",
	default => sub { {} },
);

after "BUILDALL" => sub {
	my $self = shift;
	$self->_reindex_hash;
};

sub _reindex_hash {
	my $self = shift;
	my @transitions = $self->transitions;

	for ( @transitions ) {
		blessed($_)
			or croak (($_||'') . " is not an object");

		$_->can("name")
			or croak "All transitions registered with a hash based state must know their own name";
	}

	$self->transition_hash({ map { $_->name => $_ } @transitions });
}

after transitions => sub {
	my ( $self, @transitions ) = @_;

	if ( @transitions ) {
		$self->_reindex_hash;
	}
};

after clear_transitions => sub {
	my $self = shift;
	$self->transition_hash({});
};

after qw/remove_transitions add_transitions/ => sub {
	my $self = shift;
	$self->_reindex_hash;
};

around has_transition => sub {
	my $next = shift;
	my ( $self, $transition ) = @_;
	if ( blessed( $transition ) ) {
		return $self->$next( $transition );
	} else {
		return exists $self->transition_hash->{$transition};
	}
};

around has_transitions => sub {
	my $next = shift;
	my ( $self, @transitions ) = @_;

	foreach my $t ( @transitions ) {
		return unless $self->has_transition( $t );
	}

	return 1;
};

sub get_transition {
	my ( $self, $transition ) = @_;
	return ( blessed($transition) ? $transition : $self->transition_hash->{$transition} );
}

sub get_transitions {
	my ( $self, @transitions ) = @_;

	if ( @transitions ) {
		return map { $self->get_transition( $_ ) } @transitions;
	} else {
		return $self->transitions;
	}
}

__PACKAGE__;

__END__