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]