File Coverage

blib/lib/Role/Commons.pm

Criterion	Covered	Total	%
statement	63	80	78.7
branch	14	30	46.6
condition	4	8	50.0
subroutine	13	15	86.6
pod	2	2	100.0
total	96	135	71.1

use 5.008;
use strict;
use warnings;

package Role::Commons;

use Carp qw[ carp croak ];
use Module::Runtime qw[ use_package_optimistically ];
use Moo::Role qw[];
use Types::TypeTiny qw[ HashLike ArrayLike ];

BEGIN {
	$Role::Commons::AUTHORITY = 'cpan:TOBYINK';
	$Role::Commons::VERSION   = '0.103';
}

my @ALL = qw(
	Authority
	ObjectID
	Tap
);

sub parse_arguments
{
	my $class = shift;

	# Translate "-all".
	my $all = 0;
	my @args = grep { /^\-all$/i ? do { $all++; 0 } : 1 } @_;
	unshift @args, @ALL if $all;

	my %roles;
	my %options;
	while (my $name = shift @args)
	{
		my $details;
		if ($name =~ /^-/ or ref $args[0])
			{ $details = shift @args }

		if ($name =~ /^\-(.+)$/i)
			{ $options{ lc $1 } = $details }
		else
			{ $roles{ $name } = $details }
	}

	carp "Role::Commons - no roles specified"
		if keys %options && !keys %roles;

	return(\%roles, \%options);
}

sub import
{
	my $class  = shift;
	my ($roles, $options) = $class->parse_arguments(@_);
	$options->{into} = caller unless exists $options->{into};

	foreach my $role (sort keys %$roles)
	{
		use_package_optimistically( join q[::], $class, $role );
	}

	'Moo::Role'->apply_roles_to_package(
		$options->{into},
		map { join q[::], $class, $_ } sort keys %$roles,
	);

	foreach my $role (sort keys %$roles)
	{
		my $role_pkg = join q[::], $class, $role;
		my $details  = $roles->{$role};
		my $setup_method = do {
			no strict 'refs';
			${"$role_pkg\::setup_for_class"};
		} or next;
		$role_pkg->$setup_method(
			$options->{into},
			HashLike->check($details)
				? %$details
				: ( ArrayLike->check($details) ? @$details : (option => $details) ),
		);
	}
}

sub apply_roles_to_object
{
	my $class  = shift unless blessed($_[0]);
	my $object = shift;
	my ($roles, $options) = $class->parse_arguments(@_);

	foreach my $role (sort keys %$roles)
	{
		use_package_optimistically( join q[::], $class, $role );
	}

	'Moo::Role'->apply_roles_to_object(
		$object,
		map { join q[::], $class, $_ } sort keys %$roles,
	);

	foreach my $role (sort keys %$roles)
	{
		my $role_pkg = join q[::], $class, $role;
		my $details  = $roles->{$role};
		my $setup_method = do {
			no strict 'refs';
			${"$role_pkg\::setup_for_class"};
		} || sub { 0 };
		$role_pkg->$setup_method(
			ref($object),
			HashLike->check($details)
				? %$details
				: ( ArrayLike->check($details) ? @$details : (option => $details) ),
		);
		$setup_method = do {
			no strict 'refs';
			${"$role_pkg\::setup_for_object"};
		} or next;
		$role_pkg->$setup_method(
			$object,
			HashLike->check($details)
				? %$details
				: ( ArrayLike->check($details) ? @$details : (option => $details) ),
		);
	}
}

1;

__END__