package Foo::Bar;
use vars qw( $VERSION );
sub method {
my $self = shift;
my $ego = __PACKAGE__.'::_implement::helper';
print "Foo::Bar::method: method = ", $ego->($self),"\n"
}
package Foo::Bar::_implement;
use Alter qw(ego);
sub helper {
ego( shift)->{'method'};
}
sub Foo::Bar::objectPackage {
"Foo::Bar::Object";
}
sub Foo::Bar::new {
my $class = shift;
warn "Foo::Bar::new(@_), class = $class\n";
my $thingy = bless \ my $ref, $class;
ego ($thingy,{@_});
print "new thingy = $thingy\n";
$thingy;
}
sub Foo::Bar::Object::method {
my $self = shift;
print "Foo::Bar::Object::method: \$self = $self\n";
my $corona = ego( $self);
print "Foo::Bar::Object::method: method = ",$corona->{'method'},"\
+n";
print "helper returns ",helper($self),"\n";
}
1;
#!/usr/bin/perl
my $foo = Foo::Bar->new(method => 'helper');
print "foo isa $foo\n";
$foo->method;
my $meth = $foo->objectPackage.'::method';
$foo->$meth;
__END__
Foo::Bar::new(method helper), class = Foo::Bar
new thingy = Foo::Bar=SCALAR(0x8205ba4)
foo isa Foo::Bar=SCALAR(0x8205ba4)
Foo::Bar::method: method = helper
Foo::Bar::Object::method: $self = Foo::Bar=SCALAR(0x8205ba4)
Foo::Bar::Object::method: method = helper
helper returns helper
hmm... well (I might not have it populated like you would do :-). The Foo::Bar::new method is compiled into the package Foo::Bar::_implement, so a Foo::Bar object's class stash (or corona) will not be visible within methods compiled directly into the package Foo::Bar, and the only way is to crank the object through the "helper" sub above.
But even if Foo::Bar is compiled into Foo::Bar::_implement, the corona can be forced into "the right package" (Foo::Bar) by swichting the package in the constructor:
package Foo::Bar::_implement;
sub Foo::Bar::new {
my $class = shift;
my $thingy = bless \ my $ref, $class;
package Foo::Bar;
ego ($thingy,{@_});
package Foo::Bar::_implement;
$thingy;
}
which might also not be what you want. But somehow it must be decided what the "class" is supposed to be - is it the package or the subroutine qualifier? If it is the latter - quoting you from a previous note,
The correct "class" is the package part of the subroutine name that was used to find the subroutine when the method was looked up (looking in symbol tables and following @ISA). Unfortunately, I have yet to see a way to get this information.
how could that be different from what $class is in ($class = (caller(0))[3] ) =~ s/::[^:]+$// ?
--shmem
_($_=" "x(1<<5)."?\n".q·/)Oo. G°\ /
/\_¯/(q /
---------------------------- \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}
| 