File Coverage

blib/lib/Dispatch/Class.pm

Criterion	Covered	Total	%
statement	25	25	100.0
branch	9	10	90.0
condition	4	5	80.0
subroutine	8	8	100.0
pod	2	2	100.0
total	48	50	96.0

package Dispatch::Class;

use warnings;
use strict;

our $VERSION = '0.01';

use Sub::Exporter -setup => {
	exports => [
		qw(
			class_case
			dispatch
		)
	],
};

use Scalar::Util qw(blessed);

sub class_case {
	my @prototable = @_;
	sub {
		my ($x) = @_;
		my $blessed = blessed $x;
		my $ref = ref $x;
		my $DOES;
		my @table = @prototable;
		while (my ($key, $value) = splice @table, 0, 2) {
			return $value if
				!defined $key ? !defined $x :
				$key eq '*' ? 1 :
				$key eq ':str' ? !$ref :
				$key eq $ref ? 1 :
				$blessed && ($DOES ||= $x->can('DOES') || 'isa', $x->$DOES($key))
			;
		}
		()
	}
}

sub dispatch {
	my $chk = &class_case;
	sub { ($chk->($_[0]) || return)->($_[0]) }
}

'ok'

__END__