in reply to REALLY Private Methods in perl: Is Perl Flexible enough to be made Inflexible?
Now the $_tutu method is visible only inside the closure enclosing the Tutu package.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();
When executed gives the following output:#!/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();
$ 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 ./attributeprotectedwi +thlocal.pl line 49.
produces the following output: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");
$ attributeprotected.pl Yes, main can see that SomeClass has a _bar method
I wrote Parse::Eyapp a LALR compiler compiler
(s.t. similar to Parse::RecDescent).
From a grammar specification produces an abstract syntax tree. The tree can then be manipulated using an attribute grammar like the one provided by Luke Palmer Language::AttributeGrammar.
Language::AttributeGrammar was written with
Parse::RecDescent in mind and assumes that node children are accesed by name instead than by ordinal number, which is the way used by Parse::Eyapp.
Language::AttributeGrammar access to children
is through a private method called _get_child.
The fact that the private method wasn't really hidden allowed me to
overwrite the method and to restore it after the modification so that if later in the program
an attributed grammar - let us say for a Parse::RecDescent generated tree - needs
the old version of
_get_child
it will work. See the pertinent fragment of code
for a small calculator:
Paraphrasing Larry Wall's quote, This is like going into the living room, changing a bit the things while none is using them, and cleaning and restoring them after use so that the next visitors will find them where they expect. If the living room were totally locked (I.e. if Luke Palmer decided to use a solution like the lexical closure reference above for _get_child) we couldn't do it.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::_ge +t_child
|
|---|