package myParent;
our @ISA;

sub new {
  my $class = shift;
  bless $self,$class;
  $self->_init(@_);
  return $self;
}
sub _init {
  my $self = shift;
  print "_initParent (@_)\n";
}

#----------------------------------

package myChild;
our @ISA;
use base qw(myParent);

# This function is completely unnecessary
#sub new {
#  my $class = shift;
#  my $self = $class->SUPER::new;
#  $self->_init(@_);
#  return $self;
#}

sub _init {
  my $self = shift;
  print "_initChild (@_)\n";
}
[download]

------
We are the carpenters and bricklayers of the Information Age.

Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

Please remember that I'm crufty and crochety. All opinions are purely mine and all code is untested, unless otherwise specified.

The _initXXX() subs are all private subs that need to ALL be called in a cascade when an instance is created. This is the output from my example:

  _initParent a b c  [ISA: ]
  _initChild a b c  [ISA: myParent]
  _initGrandChild a b c  [ISA: myChild]
[download]

And this is the output from your mod:

 _initChild (a b c)
 _initGrandChild a b c  [ISA: myChild]
[download]

The myParent->_init() code never got executed. Yes, you could call $self->SUPER::_init(@_) in your myChild->_init(), but that is missing the point.

The _initXXX() methods are private to the respective classes - they are not part of the external interface, and are not intended to be specialised by a child class.

Hope that makes sense?

Ok. I get the picture now. (Sounds like a goofy design to me, but whatever.)

package myParent;
our @ISA;

sub new {
  my $class = shift;
  bless $self,$class;
  $self->_parent_init(@_);
  return $self;
}
sub _parent_init {
  my $self = shift;
  print "_initParent (@_)\n";
}

#----------------------------------

package myChild;
our @ISA;
use base qw(myParent);

sub new {
  my $class = shift;
  my $self = $class->SUPER::new;
  $self->_child_init(@_);
  return $self;
}

sub _child_init {
  my $self = shift;
  print "_initChild (@_)\n";
}
[download]

Etc. The idea is that your constructor is a wrapper on your parent's constructor, but you do additional things after that's called. So, the delta off your original code is that there is only one bless - in the ultimate parent's code. (You were doing a bunch of reblessing, which I think was confusing you.)

------
We are the carpenters and bricklayers of the Information Age.

Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

Please remember that I'm crufty and crochety. All opinions are purely mine and all code is untested, unless otherwise specified.

mmmm... dragonchild also thought this was a goofy design and yet I always do this - a habit tatooed into me when I was a mere Perl love-child.

So I went and checked with some venerated Object Ogres, UML Gods, demi-gods, and Snippet Slayers...

the concerted response was that as a generalisation, an inherited constructor should ALWAYS ensure that the parent constructor has been executed before doing any localised specialisation.

So I have cast around for a trivial example that shows why you MUST call the parent class constructor...

This is the output from the code below - $enterprise works, but $voyager blows up!

Starting Enterprise...
StarShip initialised...
Enterprise starship initialised...
Enterprise crew count: 0

Starting Voyager...
Voyager starship initialised...
Can't use an undefined value as an ARRAY reference 
  at ./trek.pl line 39.
[download]

The difference is that Enterprise correctly calls the StarShip constructor, whereas Voyager decides to do its own thing, not realising that they are saving up a warp breach!

#!/usr/local/bin/perl -w
use strict;

# This example shows why child class should always
# execute their parent constructor:
# - Enterprise class gets it right
# - Voyager class blows up

print "Starting Enterprise...\n";

my $enterprise = Enterprise->new( 
  captain => 'pickard', 
  compliment => 3000 );

print "Enterprise crew count: ", 
      $enterprise->getCrewCount(),"\n\n";

print "Starting Voyager...\n";
my $voyager = Voyager->new( 
  captain => 'janeway', 
  compliment => 300 );
print "Voyager crew count: ", 
  $voyager->getCrewCount(),"\n\n";

#---------------------------------------------------
package StarShip;
sub new {
  my $class = shift;
  my $self = {};
  bless $self,$class;
  $self->_ssInit(@_);
  return $self;
}
sub _ssInit {
  my $self = shift;
  my %param = @_;
  for my $property qw( captain compliment ) {
    die "StarShip: missing '$property'"
      unless $param{$property};
    $self->{$property} = $param{$property};
  }
  $self->{crew} = [];
  print "StarShip initialised...\n";
}
sub getCrewCount {
  my $self = shift;
  return scalar @{$self->{crew}};
}

#---------------------------------------------------
package Enterprise;
use base qw(StarShip);
sub new {
  my $class = shift;
  # We perform our parents constructor
  # to ensure that our object is in a consistent
  # state from the parents perspective
  my $self = $class->SUPER::new(@_);
  $self->_entInit(@_);
  return $self;
}
sub _entInit {
  my $self = shift;
  $self->{class}  = 'constellation';
  $self->{id}     = 'NCC1701D';
  print "Enterprise starship initialised...\n";
}

#---------------------------------------------------
package Voyager;
use base qw(StarShip);
sub new {
  my $class = shift;
  # Whoops - we didnt call StarShip constructor!
  my $self = {};
  bless $self,$class;
  $self->_voyagerInit(@_);
  return $self;
}
sub _voyagerInit {
  my $self = shift;
  $self->{class}  = 'smaller';
  $self->{id}     = 'VOYAGER1';
  $self->jumpTo('gamma quadrant');
  print "Voyager starship initialised...\n";
}
sub jumpTo {
  my $self = shift;
  $self->{x} = rand(-1)*1000;
  $self->{y} = rand(-1)*1000;
  $self->{z} = rand(-1)*1000;
}
[download]