amachangのサンプルも、このとおり。

use strict;
use warnings;
use Object::Prototype;
use utf8;
sub alert{ warn @_ };

my $animal = Object::Prototype->new({}, {
    breath => sub{
        alert('すーはー');
    }
});

# 鳥さんのプロトタイプ
my $bird = Object::Prototype->new($animal);
$bird->prototype(fly => sub{
    alert('ばたばた');
});

# ペンギンさんのプロトタイプ
my $penguin = Object::Prototype->new($bird);
$penguin->prototype(fly => sub {
    alert('飛べない');
});

# ドンペン君
my $donpen = Object::Prototype->new($penguin);
$donpen->prototype(sing => sub {
    alert('どんどんどんどんきー♪ドンキーホーテー！');
});

$donpen->breath(); # 動物だから呼吸できる
$donpen->fly(); # ペンギンは飛べない
$donpen->sing(); # ドンキホーテーの歌を歌う

# 実は鳥は歩ける
$bird->prototype(walk => sub {
    alert('てくてく');
});

$donpen->walk(); # 鳥なので「てくてく」歩ける

# でも、ペンギンは「てくてく」じゃなく「ぴょこぴょこ」だ
$penguin->prototype(walk => sub {
    alert('ぴょこぴょこ');
});

$donpen->walk(); # ぴょこぴょこ

% perl -Ilib t/chain.pl
すーはー at t/chain.pl line 5.
飛べない at t/chain.pl line 5.
どんどんどんどんきー♪ドンキーホーテー！ at t/chain.pl line 5.
てくてく at t/chain.pl line 5.
ぴょこぴょこ at t/chain.pl line 5.

package Object::Prototype;

# $Id: Prototype.pm,v 0.1 2006/10/22 10:28:51 dankogai Exp dankogai $
use 5.008001;
use strict;
use warnings;
use Carp;
use Scalar::Util qw(refaddr);
use Storable ();

our $VERSION = sprintf "%d.%02d", q$Revision: 0.1 $ =~ /(\d+)/g;
our $DEBUG = 0;
my %constructor_of;
my %prototype_of;

sub new($$;$) {
    my $class       = shift;
    my $constructor = shift;
    my $self        = Storable::dclone($constructor);
    my $id          = refaddr $self;
    $constructor_of{$id} = $constructor;
    $prototype_of{$id}   = {};
    bless $self => $class;
    for my $method ( keys %{ $_[0] } ) {
        $self->prototype( $method, $_[0]->{$method} );
    }
    return $self;
}

sub prototype($$;$) {
    my $self   = shift;
    my $id     = refaddr $self;
    my $method = shift;
    $prototype_of{$id}{$method} = shift if @_;
    return $prototype_of{$id}{$method};
}

sub constructor($) {
    my $self   = shift;
    my $id     = refaddr $self;
    return $constructor_of{$id}
}

sub DESTROY {
    my $id = refaddr shift;
    carp "DESTROY: $id" if $DEBUG;
    delete $constructor_of{$id};
    delete $prototype_of{$id};
}

sub AUTOLOAD {
    my $self   = shift;
    my $method = our $AUTOLOAD;
    $method =~ s/.*:://o;
    my $id = refaddr $self;
    warn "$id -> $method" if $DEBUG;
    my $code = $prototype_of{$id}{$method};
    return $self->$code(@_) if $code;
    while ( my $constructor = $constructor_of{$id} ) {
        warn "$constructor -> $method" if $DEBUG;
        $id = refaddr $constructor;
        $code = ref $constructor eq ref $self
          ? $prototype_of{$id}{$method}    # Prototypal
          : $constructor->can($method);    # Classical Perl Obj.
        return $self->$code(@_) if $code;
    }
    confess "unknown method : $method" if !$code;
}

1;
__END__

見ての通り、AUTOLOADでtrapしているので速度的には問題アリですが、その代わり普通のClassical ObjectもPrototypeに出来ます。

use strict;
use warnings;
use Object::Prototype;
use URI;
use Data::Dumper;
#local($Object::Prototype::DEBUG) = 1;
my $proto = URI->new("http://blog.livedoor.jp/dankogai/index.rdf");
my $obj   = Object::Prototype->new($proto);
$obj->prototype(dump => sub{ $_[0]->as_string });
warn Dumper $obj;
warn $obj->path;
$obj->query_form(foo => 1, bar => 2);
warn $obj->dump;

Advanced Perl Programming, 2nd Ed.
Simon Cozens
[邦訳:実用Perlプログラミング第2版]

何でこの実装が動くのかが疑問な方は、黒豹に相談してください。

Enjoy!

Dan the Man with Too Many Ways to Implement Object Systems