File Coverage

blib/lib/UNIVERSAL/DOES.pm

Criterion	Covered	Total	%
statement	22	37	59.4
branch	11	18	61.1
condition	6	6	100.0
subroutine	4	5	80.0
pod	2	2	100.0
total	45	68	66.1

package UNIVERSAL::DOES;

use 5.005_03;

$VERSION = '0.005';

use Exporter;
@ISA       = qw(Exporter);
@EXPORT_OK = qw(does);

use strict;

*UNIVERSAL::DOES = \&DOES
	unless defined &UNIVERSAL::DOES;

# Take compatibility rather than performance.
sub DOES :method {
	my($invocant, $role) = @_;

	if(@_ != 2){
		require Carp;
		Carp::croak('Usage: invocant->DOES(kind)');
	}

	my $e = do{
		local $@;
		eval{ $invocant->isa($role) } and return 1;
		$@;
	};

	if($e){
		$e =~ s/\b isa \b/DOES/xmsg;
		die $e;
	}

	return 0;
}

my %operator_of = (
	SCALAR => '${}',
	ARRAY  => '@{}',
	HASH   => '%{}',
	CODE   => '&{}',
	GLOB   => '*{}',
);

sub does {
	my($thing, $role) = @_;

	if(@_ != 2){
		require Carp;
		Carp::croak('Usage: does(thing, role)');
	}

	return 0 unless $thing && $role;

	my $e = do{
		local $@;
		eval{ $thing->DOES($role) } and return 1;
		$@;
	};

	if($e){ # $thing is not an invocant
		return ref($thing) eq $role; # ARRAY, HASH, etc.
	}
	elsif(ref($thing)){ # $thins is an object
		my $operator = $operator_of{$role} or return 0;

		return $thing->can('()')             # overloaded?
			&& $thing->can('(' . $operator); # with the dereferencing operator?
	}

	return 0;
}

1;
__END__