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.04';

use Scalar::Util qw(blessed);

use parent 'Exporter::Tiny';
our @EXPORT_OK = qw(
    class_case
    dispatch
);

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__