{ package root; sub new { bless ['yo'], shift } package left; @ISA = 'root'; sub branch { print 'yo, I be in: ', __PACKAGE__,$/ } package right; @ISA = 'root'; sub branch { print 'yo, I be in: ', __PACKAGE__,$/ } package righterer; @ISA = 'right'; sub branch { print 'calling big bro ...',$/; shift->SUPER::branch } } sub Class::SetISA::munge_isa { my($self => $obj, @pkgs) = @_; my $objclass = ref $obj; my $newclass = 'Class::SetISA::' . join '::', $objclass, @pkgs; unless(defined %{"$newclass\::"}) { *{"$newclass\::$_"} = *{"$objclass\::$_"} for keys %{"$objclass\::"}; } @{"$newclass\::ISA"} = @pkgs; bless $obj, $newclass; } my $obj = righterer->new; $obj->branch; print "obj is $obj\n"; ## be sure to include any existing classes you want to keep in @ISA Class::SetISA->munge_isa($obj, 'left'); $obj->branch; print "obj is $obj\n"; __output__ calling big bro ... yo, I be in: right obj is righterer=ARRAY(0x9486304) calling big bro ... yo, I be in: left obj is Class::SetISA::righterer::left=ARRAY(0x9486304)