Attribute::Protected - implementing proctected methods with attributes


Attribute-Protected documentation Contained in the Attribute-Protected distribution.

Index


Code Index:

NAME

Top

Attribute::Protected - implementing proctected methods with attributes

SYNOPSIS

Top

  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

DESCRIPTION

Top

Attribute::Protected implements something like public / private / protected methods in C++ or Java.

ATTRIBUTES

Top

Public
  sub foo : Public { }

just a mark. Can be called from everywhere.

Private
  sub _bar : Private { }

Can't be called from outside the class where it was declared.

Protected
  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!.

THOUGHT

Top

AUTHOR

Top

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.

SEE ALSO

Top

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__