package SUPERB;
use Carp;

sub AUTOLOAD {
    my $self   = shift;
    my $caller = caller;
    $AUTOLOAD  =~ s/.*:://;
    
    for my $method ($AUTOLOAD, "AUTOLOAD") {
        my @queue = @{"$caller\::ISA"};

        while (@queue) {
            my $class = shift @queue;

            if ( *{"$class\::$method"}{CODE} ) {
                my $call = "$class\::$AUTOLOAD";
                return $self->$call(@_);
            } else {
                push @queue, @{"$class\::ISA"};
            }
        }
    }
    
    my $class = ref $self || $self;
    croak qq[Can't locate object method "$AUTOLOAD" via package "$class"];

}

1;

##</code><code>##

use SUPERB;

package Base;
sub foo { print "Base::foo\n"; }
sub bar { print "Base::bar\n"; }
sub baz { print "Base::baz\n"; }

package A; @ISA = qw/Base/;
sub foo { print "A::foo\n"; }

package B; @ISA = qw/Base/;
sub bar { print "B::bar\n"; }

package C; @ISA = qw/A B/;
sub foo { print "C::foo\n"; shift->SUPERB::foo; }
sub bar { print "C::bar\n"; shift->SUPERB::bar; }
sub baz { print "C::baz\n"; shift->SUPERB::baz; }

package main;

my $c = bless [], 'C';
$c->foo;
$c->bar;
$c->baz;

__OUTPUT__
C::foo
A::foo
C::bar
B::bar
C::baz
Base::baz

##</code><code>##

package bfs_dispatch;
use Carp;

sub import {
    my ($x, @isa) = @_;
    my $caller    = caller;

    *{"$caller\::AUTOLOAD"} = sub {
        my $self = shift;
    
        $AUTOLOAD =~ s/.*:://;
    
        for my $method ($AUTOLOAD, "AUTOLOAD") {
            my @queue = @isa;
    
            while (@queue) {
                my $class = shift @queue;
    
                if ( my $code = *{"$class\::$method"}{CODE} ) {
                    my $call = "$class\::$AUTOLOAD";
                    return $self->$call(@_);
                } else {
                    push @queue, @{"$class\::ISA"};
                }
            }
        }
    
        my $class = ref $self || $self;
        croak qq[Can't locate object method "$AUTOLOAD" via package "$class"];
    };

}

1;

##</code><code>##

## replace this:

package C; @ISA = qw/A B/;
sub foo { print "C::foo\n"; shift->SUPERB::foo; }
sub bar { print "C::bar\n"; shift->SUPERB::bar; }
sub baz { print "C::baz\n"; shift->SUPERB::baz; }

## with this:

package C;
use bfs_dispatch qw/A B/;

## methods deleted, lets see if the method dispatcher finds the correct one!

##</code><code>##

__OUTPUT__
A::foo
B::bar
Base::baz

##</code><code>##

package C;
@ISA = qw/A B/;
sub foo { $_[0]->SUPERB::foo(@_[1..$#_]); }
sub bar { $_[0]->SUPERB::bar(@_[1..$#_]); }
sub baz { $_[0]->SUPERB::baz(@_[1..$#_]); }