File Coverage

blib/lib/Class/Protected.pm

Criterion	Covered	Total	%
statement	30	36	83.3
branch			n/a
condition			n/a
subroutine	10	12	83.3
pod	0	2	0.0
total	40	50	80.0

package Class::Protected;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.01.02';
our $DEBUG = 0;

use Carp;

use Class::Maker;

use Class::Proxy;

use Decision::ACL;
use Decision::ACL::Rule;
use Decision::ACL::Constants qw(:rule);

use IO::Extended qw(:all);

our $uid;

Class::Maker::class
{
	isa => [qw( Class::Proxy )],

	public =>
	{
		hash => [qw( table )],

		ref => { acl => 'Decision::ACL' },
	},

	default =>
	{
		events =>
		{
			method => sub
			{
				my ( $this, $e, $m, $victim, $args ) = @_;

				my $uid = shift @{$args};

				unless( ACL_RULE_ALLOW eq $this->test_acl( pkg => ref ${ $victim }, method => ${ $m }, uid => $Class::Protected::uid ) )
				{
					croak sprintf "Die because of ACL restrictions on protected class '%s'. '%s' is rejected to access method '%s'", ref ${ $victim }, $Class::Protected::uid, ${$m} ;
				}
			},
		},
	},
};

sub add_acl_rule : method
{
	my $this = shift;

	my %rule = @_;

return $this->acl->push_rule( Decision::ACL::Rule->new( \%rule ) );
}

sub test_acl : method
{
	my $this = shift;

	my %rule = @_;

return $this->acl->run_acl( \%rule );
}
		# guard is only working on blessed references (tie interface for Class::Proxy could
		# wave this constrain).
1;
__END__