Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Dynamic inheritance

by ayoung (Initiate)
on Aug 06, 2004 at 07:04 UTC ( #380466=perlquestion: print w/replies, xml ) Need Help??
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;

Replies are listed 'Best First'.
Re: Dynamic inheritance
by fergal (Chaplain) on Aug 06, 2004 at 09:20 UTC
Re: Dynamic inheritance
by hv (Parson) on Aug 06, 2004 at 10:42 UTC

    You don't particularly need the eval to set @ISA:

    no strict 'refs'; @{ "${package}::ISA" } = $base;

    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() };
    .. or if you aren't using the eval() to protect against dying, even:
    $self = $package->Spawn();

    Hugo

      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

        I think there was something about ->can vs writes to ::ISA.
        So it may not work in this case.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://380466]
Approved by davido
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (7)
As of 2018-06-19 08:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?



    Results (111 votes). Check out past polls.

    Notices?