File Coverage

blib/lib/Attribute/Protected.pm

Criterion	Covered	Total	%
statement	46	46	100.0
branch	4	4	100.0
condition			n/a
subroutine	14	14	100.0
pod	0	3	0.0
total	64	67	95.5

package Attribute::Protected;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.03';

use Attribute::Handlers;

sub UNIVERSAL::Protected : ATTR(CODE) {
    my($package, $symbol, $referent, $attr, $data, $phase) = @_;
    my $meth = *{$symbol}{NAME};
    no warnings 'redefine';
    *{$symbol} = sub {
	unless (caller->isa($package)) {
	    require Carp;
	    Carp::croak "$meth() is a protected method of $package!";
	}
	goto &$referent;
    };
}

sub UNIVERSAL::Private : ATTR(CODE) {
    my($package, $symbol, $referent, $attr, $data, $phase) = @_;
    my $meth = *{$symbol}{NAME};
    no warnings 'redefine';
    *{$symbol} = sub {
	unless (caller eq $package) {
	    require Carp;
	    Carp::croak "$meth() is a private method of $package!";
	}
	goto &$referent;
    };
}

sub UNIVERSAL::Public : ATTR(CODE) {
    my($package, $symbol, $referent, $attr, $data, $phase) = @_;
    # just a mark, do nothing
}

1;
__END__