| Attribute-Protected documentation | Contained in the Attribute-Protected distribution. |
Attribute::Protected - implementing proctected methods with attributes
package SomeClass;
use Attribute::Protected;
sub foo : Public { }
sub _bar : Private { }
sub _baz : Protected { }
sub another {
my $self = shift;
$self->foo; # OK
$self->_bar; # OK
$self->_baz; # OK
}
package DerivedClass;
@DerivedClass::ISA = qw(SomeClass);
sub yetanother {
my $self = shift;
$self->foo; # OK
$self->_bar; # NG: private method
$self->_baz; # OK
}
package main;
my $some = SomeClass->new;
$some->foo; # OK
$some->_bar; # NG: private method
$some->_baz; # NG: protected method
Attribute::Protected implements something like public / private / protected methods in C++ or Java.
sub foo : Public { }
just a mark. Can be called from everywhere.
sub _bar : Private { }
Can't be called from outside the class where it was declared.
sub _baz : Protected { }
Can be called from the class where it was declared or its derived classes.
When called from inappropriate classes, those methods throw an
exception like foo() is a protected method of Foo!.
Tatsuhiko Miyagawa <miyagawa@bulknews.net>
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
Attribute::Handlers, protect, Class::Fields
| Attribute-Protected documentation | Contained in the Attribute-Protected distribution. |
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__