File Coverage

blib/lib/Smart/Dispatch/Table.pm

Criterion	Covered	Total	%
statement	56	88	63.6
branch	9	42	21.4
condition	5	18	27.7
subroutine	17	24	70.8
pod	10	10	100.0
total	97	182	53.3

package Smart::Dispatch::Table;

BEGIN {
	*_TYPES = $ENV{PERL_SMART_DISPATCH_TYPE_CHECKS}==42
		? sub () { 1 }
		: sub () { 0 };
};

use 5.010;
use Moo;
use Carp;
use Scalar::Util qw/ refaddr blessed /;
use if _TYPES, 'MooX::Types::MooseLike::Base', ':all';

sub _swap
{
	my ($x, $y, $swap) = @_;
	$swap ? ($y, $x) : ($x, $y);
}

use namespace::clean;

BEGIN {
	$Smart::Dispatch::Table::AUTHORITY = 'cpan:TOBYINK';
	$Smart::Dispatch::Table::VERSION   = '0.004';
}

use overload
	'&{}'    => sub { my $x=shift; sub { $x->action($_[0]) } },
	'+'      => sub { __PACKAGE__->make_combined(reverse _swap(@_)) },
	'.'      => sub { __PACKAGE__->make_combined(_swap(@_)) },
	'+='     => 'prepend',
	'.='     => 'append',
	'~~'     => 'exists',
	'bool'   => sub { 1 },
;

has match_list => (
	(_TYPES?(isa=>ArrayRef()):()),
	is        => 'rw',
	required  => 1,
);

sub BUILD
{
	my ($self) = @_;
	$self->validate_match_list;
}

sub make_combined
{
	my ($class, @all) = @_;
	my $self = $class->new(match_list => []);
	$self->append(@all);
}

sub validate_match_list
{
	my ($self) = @_;
	my @otherwise = $self->unconditional_matches;
	if (scalar @otherwise > 1)
	{
		carp "Too many 'otherwise' matches. Only one allowed.";
	}
	if (@otherwise and refaddr($otherwise[0]) != refaddr($self->match_list->[-1]))
	{
		carp "The 'otherwise' match is not the last match.";
	}
}

sub all_matches
{
	my ($self) = @_;
	@{ $self->match_list };
}

sub unconditional_matches
{
	my ($self) = @_;
	grep { $_->is_unconditional } @{ $self->match_list };
}

sub conditional_matches
{
	my ($self) = @_;
	grep { !$_->is_unconditional } @{ $self->match_list };
}

sub exists
{
	my ($self, $value, $allow_fails) = @_;
	foreach my $cond (@{ $self->match_list })
	{
		if ($cond->value_matches($value))
		{
			if ($allow_fails or not $cond->is_failover)
			{
				return $cond;
			}
			else
			{
				return;
			}
		}
	}
	return;
}

sub action
{
	my ($self, $value, @args) = @_;
	my $cond = $self->exists($value, 1);
	return $cond->conduct_dispatch($value, @args) if $cond;
	return;
}

sub append
{
	my $self = shift;
	foreach my $other (@_)
	{
		next unless defined $other;
		carp "Cannot add non-reference to dispatch table"
			unless ref $other;
		carp "Cannot add non-blessed reference to dispatch table"
			unless blessed $other;

		if ($other->isa(__PACKAGE__))
		{
			$self->match_list([
				$self->conditional_matches,
				$other->conditional_matches,
				($self->unconditional_matches ? $self->unconditional_matches : $other->unconditional_matches),
			]);
		}
		elsif ($other->isa('Smart::Dispatch::Match')
		and not $other->is_unconditional)
		{
			$self->match_list([
				$self->conditional_matches,
				$other,
				$self->unconditional_matches,
			]);
		}
		elsif ($other->isa('Smart::Dispatch::Match')
		and $other->is_unconditional)
		{
			$self->match_list([
				$self->conditional_matches,
				($self->unconditional_matches ? $self->conditional_matches : $other),
			]);
		}
		else
		{
			carp sprintf("Cannot add object of type '%s' to dispatch table", ref $other);
		}
	}

	$self->validate_match_list;
	return $self;
}

sub prepend
{
	my $self = shift;
	foreach my $other (@_)
	{
		next unless defined $other;
		carp "Cannot add non-reference to dispatch table"
			unless ref $other;
		carp "Cannot add non-blessed reference to dispatch table"
			unless blessed $other;

		if ($other->isa(__PACKAGE__))
		{
			$self->match_list([
				$other->conditional_matches,
				$self->conditional_matches,
				($other->unconditional_matches ? $other->unconditional_matches : $self->unconditional_matches),
			]);
		}
		elsif ($other->isa('Smart::Dispatch::Match')
		and not $other->is_unconditional)
		{
			$self->conditions([
				$other,
				$self->conditional_matches,
				$self->unconditional_matches,
			]);
		}
		elsif ($other->isa('Smart::Dispatch::Match')
		and $other->is_unconditional)
		{
			$self->conditions([
				$self->conditional_matches,
				$other,
			]);
		}
		else
		{
			carp sprintf("Cannot add object of type '%s' to dispatch table", ref $other);
		}
	}

	$self->validate_match_list;
	return $self;
}

__PACKAGE__
__END__