[Bioperl-l] multiple inheritance

[Lincoln Stein]

OK, here's my solution to this particular problem.  The inheritance
hierarchy is:

        A
        /\
       B  C
        \/
         D
         |
         E

Here's the test script:

use E;

my $a1  = A->new(qw(A initialization stuff));
print "\n";

my $b1  = B->new(qw(B initialization stuff));
print "\n";

my $c1  = C->new(qw(C initialization stuff));
print "\n";

my $d1  = D->new(qw(D initialization stuff));
print "\n";

my $e1  = E->new(qw(E initialization stuff));
print "\n";

And here's its output:

A: initializing a A=HASH(0x8124394) with A initialization stuff

A: initializing a B=HASH(0x81244cc) with B initialization stuff
B: initializing a B=HASH(0x81244cc) with B initialization stuff

A: initializing a C=HASH(0x813b2c4) with C initialization stuff
C: initializing a C=HASH(0x813b2c4) with C initialization stuff

A: initializing a D=HASH(0x813b324) with D initialization stuff
B: initializing a D=HASH(0x813b324) with D initialization stuff
C: initializing a D=HASH(0x813b324) with D initialization stuff
D: initializing a D=HASH(0x813b324) with D initialization stuff

A: initializing a E=HASH(0x813b378) with E initialization stuff
B: initializing a E=HASH(0x813b378) with E initialization stuff
C: initializing a E=HASH(0x813b378) with E initialization stuff
D: initializing a E=HASH(0x813b378) with E initialization stuff
E: initializing a E=HASH(0x813b378) with E initialization stuff

As shown in the attached code, there's some magic in base class A that
causes chaining to occur and avoids initialization from occurring
more than once per class per object.  Each subclass has an initialization
method that looks like this:

	sub initialize {
		my $self = shift;
		$self->initialize_chain(@_);
		# do own initialization
	}

Lincoln

# ------------------------
# FILE: A.pm
# ------------------------
package A;

our %seenit;

sub new {
  my $class = shift;
  my $self  = bless {},ref $class || $class;
  $self->initialize(@_);
  $self;
}

sub initialize {
  my $self = shift;
  warn __PACKAGE__ . ": initializing a $self with @_\n";
}

sub initialize_chain {
  my $self    = shift;
  local %seenit unless %seenit;
  $self->_initialize_chain(@_);
}

sub _initialize_chain {
  my $self    = shift;

  my $package = caller(1);
  for my $parent (@{"$package\:\:ISA"}) {
    next if $seenit{$parent}++;
    next unless $parent->can('initialize');
    $initialize = "$parent\:\:initialize";
    $self->$initialize(@_);
  }
}

1;

# ------------------------
# FILE: B.pm
# ------------------------
package B;

use base 'A';

sub initialize {
  my $self = shift;
  $self->initialize_chain(@_);
  warn __PACKAGE__ . ": initializing a $self with @_\n";
}

1;

# ------------------------
# FILE: C.pm
# ------------------------
package C;

use base 'A';C

sub initialize {
  my $self = shift;
  $self->initialize_chain(@_);
  warn __PACKAGE__ . ": initializing a $self with @_\n";
}

1;

# ------------------------
# FILE: D.pm
# ------------------------
package D;

use base 'B','C';

sub initialize {
  my $self = shift;
  $self->initialize_chain(@_);
  warn __PACKAGE__ . ": initializing a $self with @_\n";
}

1;

# ------------------------
# FILE: E.pm
# ------------------------
package E;

use base 'D';

sub initialize {
  my $self = shift;
  $self->initialize_chain(@_);
  warn __PACKAGE__ . ": initializing a $self with @_\n";
}

1;


-- 
Lincoln Stein
lstein at cshl.edu
Cold Spring Harbor Laboratory
1 Bungtown Road
Cold Spring Harbor, NY 11724
(516) 367-8380 (voice)
(516) 367-8389 (fax)