package ObjectClass; use Carp; use strict; use vars qw($AUTOLOAD); sub call { my $self = shift; my $meth = $self->find_meth(shift); $meth->(@_); } sub def { my $self = shift; { my $meth = shift; my $implement = shift; $self->{meth_cache}->{$meth} = $implement; redo if @_; } } sub find_meth { my $self = shift; my $meth = shift; my $cache = $self->{meth_cache}; if (exists $cache->{$meth}) { return $cache->{$meth}; } elsif (exists $self->{proto}) { return $self->{proto}->find_meth($meth); } else { confess ("Object does not implement method '$meth'"); } } sub new { my $proto = shift; # Note for Merlyn, this time it is not cargo-cult programming! :-P unless (ref($proto)) { my $class = $proto; $proto = { meth_cache => {}, }; bless($proto, $class); } my $self = { meth_cache => {}, proto => $proto }; bless $self, ref($proto); } sub AUTOLOAD { my $self = shift; $AUTOLOAD =~ s/.*:://; return if $AUTOLOAD eq "DESTROY"; $self->call($AUTOLOAD, @_); } package main; # A simple test my $parent = new ObjectClass; $parent->def("hello", sub {print "Hello world\n"}); my $child = $parent->new(); $child->def("goodbye", sub {print "Goodbye\n"}); $parent->hello(); # Calling the defining object $child->hello(); # Inherit the method $child->goodbye(); # Method in the subclass $parent->goodbye(); # Blows up.