File Coverage

blib/lib/Role/Commons/Authority.pm

Criterion	Covered	Total	%
statement	42	46	91.3
branch	10	16	62.5
condition			n/a
subroutine	10	10	100.0
pod	1	1	100.0
total	63	73	86.3

use 5.008;
use strict;
use warnings;

package Role::Commons::Authority;

use Carp qw[croak];
use match::simple qw[match];
use Scalar::Util qw[blessed];

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

our %ENABLE_SHARED;
our %SHARED_AUTHORITIES;

our $setup_for_class = sub {
	my ($role, $package, %args) = @_;

	if ( exists $args{-authorities} )
	{
		$ENABLE_SHARED{ $package } = 1;

		ref($args{-authorities}) eq 'ARRAY' and
			$SHARED_AUTHORITIES{ $package } = $args{-authorities};
	}
};

sub AUTHORITY
{
	my ($invocant, $test) = @_;
	$invocant = ref $invocant if blessed($invocant);

	my @authorities = do {
		no strict 'refs';
		my @a = ${"$invocant\::AUTHORITY"};
		if (exists $ENABLE_SHARED{ $invocant })
		{
			push @a, @{$SHARED_AUTHORITIES{$invocant} || []};
			push @a, @{"$invocant\::AUTHORITIES"};
		}
		@a;
	};

	if (scalar @_ > 1)
	{
		my $ok = undef;
		AUTH: for my $A (@authorities)
		{
			if (match($A, $test))
			{
				$ok = $A;
				last AUTH;
			}
		}
		return $ok if defined $ok;

		@authorities
			? croak("Invocant ($invocant) has authority '$authorities[0]'")
			: croak("Invocant ($invocant) has no authority defined");
	}

	wantarray ? @authorities : $authorities[0];
}

1;

__END__