Dynamic inheritance

ayoung has asked for the wisdom of the Perl Monks concerning the following question:

I have a need to dynamicly build a stack of handlers, which allows one of a higher order to overload the functionality of its parents. ISA and bless() are one solution, but was wondering if

a) is using ISA within a eval exceptable, as i've never seen a similar construction.
b) anybody had a cleaner way todo the following.

Example output:

    Object1->Constructor
    Object2->Constructor
    Object2->Doit
    Object1->Doit

#!/usr/bin/perl
use strict;
use warnings;

package Interface;

our (@IfStack) = ();                # Toolset handle stack

sub Push {
    push (@IfStack, @_);            # push onto stack
}

sub Factory {
    sub Stacker {   
        #   Recursively build the object stack
        #   Begin
        #       Inherit base object.
        #       If end of stack,
        #           Spawn the created object (base object)
        #       Else
        #           Recursive into parent.
        #       Relate us with our child.
        #       Call constructor.
        #   End
        #..
        my ($stack, $package) = @_;    # current__PACKAGE__
        my ($base, $self);

        if ( scalar (@$stack) ) {      # inherit 'base'
            $base = pop (@$stack);
            eval "@"."$package"."::ISA=\"$base\"";  
        }

        if ( scalar (@$stack) == 0 ) { # base class .. spawn
            $self = eval( "$package->Spawn()" );
        } else {                       # unroll next object
            $self = Stacker ($stack, $base);
            $self = bless ($self, $package); 
        }
        $self->Constructor();
        return ($self);
    }

    my (@stack) = @IfStack;            # clone stack
    my ($self);

    die "ERROR: Interface -- object stack empty.\n" 
                if ( ! scalar (@stack) );
    $self = Stacker( \@stack, pop(@stack) ) ||
                die "ERROR: cannot build stack.\n";
    return $self;
}

package Interface::Base;
Interface::Push( "Interface::Base" );  # push onto stack

sub Spawn {
    my ($obclass) = shift;
    my ($class) = ref($obclass) || $obclass;
    my ($self) = {};
    return bless($self, $class);
}


###############################################
#   Object1
#..
package MyObject1;

sub Constructor {
    print "Object1->Constructor\n";
}

sub Doit {
    my ($self) = shift;
    print "Object1->Doit\n";
    $self->SUPER::Doit()               # chain
        if ($self->can("SUPER::Doit"));
}

###############################################
#   Object2
#..
package MyObject2;

sub Constructor {
    print "Object2->Constructor\n";
}

sub Doit {
    my ($self) = shift;
    print "Object2->Doit\n";
    $self->SUPER::Doit()               # chain
        if ($self->can("SUPER::Doit"));
}

###############################################
#   TEST MAIN
#.
package main;

my ($ts);
print "Main\n";
Interface::Push( "MyObject1" );       # push onto stack
Interface::Push( "MyObject2" );       # push onto stack
$ts = Interface::Factory();           # create object
$ts->Doit();                          # call
1;
[download]

Comment on Dynamic inheritance Download Code

Replies are listed 'Best First'.
Re: Dynamic inheritance by fergal (Chaplain) on Aug 06, 2004 at 09:20 UTC
Class-Prototyped might be your man. Some discussion of it here Class::Classless vs. Class::Prototyped and an article by merlyn here.	[reply]
Re: Dynamic inheritance by hv (Prior) on Aug 06, 2004 at 10:42 UTC
You don't particularly need the eval to set @ISA: `no strict 'refs'; @{ "${package}::ISA" } = $base;` [download] Note also that string-eval is slow (the code needs to be compiled each time), so it's worth avoiding when you can; the Spawn() call can be simply: `$self = eval { $package->Spawn() };` [download] .. or if you aren't using the eval() to protect against dying, even: `$self = $package->Spawn();` [download] Hugo	[reply] [d/l] [select]
Re^2: Dynamic inheritance by Prior Nacre V (Hermit) on Aug 06, 2004 at 14:14 UTC
This is absolutely correct. In a more general sense, you can perform any array operation on @ISA at runtime to dynamically alter the OO hierarchy. push(), shift(), splice(), etc. all work. Regards, PN5	[reply]
Re^3: Dynamic inheritance by Anonymous Monk on Aug 06, 2004 at 20:54 UTC
I think there was something about ->can vs writes to ::ISA. So it may not work in this case.	[reply]
Re^4: Dynamic inheritance by Prior Nacre V (Hermit) on Aug 06, 2004 at 21:15 UTC


Problems? Is your data what you think it is?
	PerlMonks