pl@nereida:~/LEyapp/examples$ cat localwithlocal3.pl
#!/usr/local/bin/perl -w
use strict;

{
  package Tutu;

  my $_tutu = sub {
    my $self = shift;

    "Inside tutu. My class is ".ref($self)."\n"
  };

  sub plim {
    my $self = shift;

    print "plim can access _tutu as a private method:\n"
          .$self->$_tutu;
  }

  sub new {
    bless {}, $_[0];
  }
}

package main;

my $obj = Tutu->new();

$obj->plim();

##</code><code>##

#!/usr/local/bin/perl -w
use strict;

package Tutu;

my $protected = sub {
  my $self = shift;

  "inside Tutu::tutu!\n"
};

sub plim {
  my $self = shift;

  local *protected = $protected;

  print "Accessing 'protected' as a method: "
        .$self->protected();
}

sub new {
  bless {}, $_[0];
}

package SubTutu;
our @ISA = qw{Tutu};

# SubTutu can overwrite 'protected'
sub protected {
  my $self = shift;

  "inside overwritten tutu!\n"
};

package main;

my $obj = SubTutu->new();

$obj->plim();

print(Tutu->can('protected')?
         (Tutu::protected()."\n")
       : "main does not even know of 'Tutu::protected'\n"
);

$obj->plim();

# Let us provoke an exception
Tutu::protected();


##</code><code>##

$ attributeprotectedwithlocal.pl
Accessing 'protected' as a method: inside overwritten tutu!
main does not even know of 'Tutu::protected'
Accessing 'protected' as a method: inside overwritten tutu!
Undefined subroutine &Tutu::protected called at ./attributeprotectedwithlocal.pl line 49.

##</code><code>##

pl@nereida:~/LEyapp/examples$ cat attributeprotected.pl
#!/usr/local/bin/perl -w
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
}

sub new {
  bless {}, $_[0]
}

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
print ($some->can('_bar')?"Yes, main can see that SomeClass has a _bar method\n":"no\n");

##</code><code>##

$ attributeprotected.pl
Yes, main can see that SomeClass has a _bar method

##</code><code>##

 94 my $attgram = new Language::AttributeGrammar <<'EOG';
 95
 96   # Compute the expression
 97   NUM:    $/.val = { $/->{attr} }
 98   TIMES:  $/.val = { $<0>.val * $<1>.val }
 99   PLUS:   $/.val = { $<0>.val + $<1>.val }
100   MINUS:  $/.val = { $<0>.val - $<1>.val }
101   UMINUS: $/.val = { -$<0>.val }
102   ASSIGN: $/.val = { $::s{$<0>->{attr}} = $<1>.val; $<1>.val }
103 EOG
104
105 {
106   # rewrite _get_child, save old version
107   no warnings 'redefine';
108   *Language::AttributeGrammar::Parser::_get_child = sub {
109       my ($self, $child) = @_;
110
111       $self->child($child);
112     };
113
114   my $res = $attgram->apply($t, 'val');
115 }
116 # Restored  old version of Language::AttributeGrammar::Parser::_get_child