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;
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|