File Coverage

blib/lib/Class/Workflow/State/TransitionHash.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

#!/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__

=pod

=head1 NAME

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

=head1 SYNOPSIS

	package MyState;
	use Moose;

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

=head1 DESCRIPTION

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

Transition storage is implemented internally with L<Set::Object>.

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

=head1 METHODS

See L<Class::Workflow::State::TransitionSet> and L<Class::Workflow::State>.

=over 4

=item get_transition $name

=item 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).

=back

=cut