Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
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 romping around the Monastery: (3)
As of 2015-07-05 08:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (61 votes), past polls