Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Attribute::Protected

by miyagawa (Chaplain)
on Aug 28, 2001 at 10:30 UTC ( #108355=sourcecode: print w/ replies, xml ) Need Help??

Category: Miscellaneous
Author/Contact Info Tatsuhiko Miyagawa <miyagawa@bulknews.net>
Description: Attribute::Protected implements something like public / private / protected methods in C++ or Java. This module requires Attribute::Handlers.
package Attribute::Protected;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.01';

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 preotected 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__

=head1 NAME

Attribute::Protected - implementing proctected methods with attributes

=head1 SYNOPSIS

  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

=head1 DESCRIPTION

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

=head1 ATTRIBUTES

=over 4

=item Public

  sub foo :Public { }

just a mark. Can be called from everywhere.

=item Private

  sub _bar :Private { }

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

=item Protected

  sub _baz :Protected { }

Can be called from the class where it was declared or its derived clas
+ses.

=back

When called from inappropriate classes, those methods throw an
exception like C<foo() is a protected method of Foo!>.

=head1 AUTHOR

Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>

=head1 SEE ALSO

L<Attribute::Handlers>, L<Protect>, L<Class::Fields>

=cut

Comment on Attribute::Protected
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://108355]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (10)
As of 2014-07-10 08:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (203 votes), past polls