alienhuman has asked for the wisdom of the Perl Monks concerning the following question:

Monks, I've got an oo design question and couldn't think of a succinct title. Bear with me if the requirements sound a little strange.

I've got a package Dragon.pm whose constructor calls an _init() method. All well and good. _init() calls another method called awaken() to print an message when an object is constructed: 

sub new() {
    my $class = shift;          # get class so constructor can be inhe
+rited
    my $self = {};
    bless ($self,$class);
    $self->_init( @_ );         # call _init here or in subclass
    return $self;
}

sub _init {
    my $self = shift;
    $self->{NAME}  = shift || undef;
    $self->{AGE}   = undef;
    $self->{COLOR} = undef;
    $self->awaken;
}
sub awaken {
    my $self = shift;
    ($self->get_name eq "nameless") ? print "A " : 0;
    print $self->get_name .", ";
    ($self->get_name ne "nameless") ? print "an " : 0;
    print $self->get_age .", ";
    print $self->get_color ." dragon awakens from his slumber!\n";
}

[download]
This all works perfectly.

I also have a subclass of Dragon.pm called Trogdor.pm with its own _init() that calls the parent _init() and then does its own initialization. 

sub _init {
    my $self = shift;
    if ($self->SUPER::_init( @_ )) {
        $self->{NAME} = "Trogdor";
        $self->{AGE}  = "one year old";
        $self->{COLOR}= "green";
        $self->burninate;
    }
    print "Trogdor::_init got called\n";
}

[download]
My problem is that SUPER::_init sets the object fields with some default (undef) values, then calls the awaken() method, which prints its message before Trogdor's _init can reset the fields with correct values.

I understand why this is happening. My question is, how would you design these two packages so that awaken() would be called after initialization, regardless of whether the object was a Dragon or a subclass of Dragon?

Here's the full code, plus a file dragons.pl to test it.

Dragon.pm 
package Dragon;
use strict;

sub new() {
    my $class = shift;          # get class so constructor can be inhe
+rited
    my $self = {};
    bless ($self,$class);
    $self->_init( @_ );         # call _init here or in subclass
    return $self;
}

sub _init {
    my $self = shift;
    $self->{NAME}  = shift || undef;
    $self->{AGE}   = undef;
    $self->{COLOR} = undef;
    $self->awaken;
}

sub get_name {
    my $self = shift;
    return $self->{NAME} || "nameless";
}

sub get_age {
    my $self = shift;
    return $self->{AGE} || "ageless";
}

sub get_color {
    my $self = shift;
    return $self->{COLOR} || "obscure";
}

sub awaken {
    my $self = shift;
    ($self->get_name eq "nameless") ? print "A " : 0;
    print $self->get_name .", ";
    ($self->get_name ne "nameless") ? print "an " : 0;
    print $self->get_age .", ";
    print $self->get_color ." dragon awakens from his slumber!\n";
}
1;

[download]
Trogdor.pm 
package Trogdor;
use strict;
use base qw(Dragon);

sub _init {
    my $self = shift;
    if ($self->SUPER::_init( @_ )) {
        $self->{NAME} = "Trogdor";
        $self->{AGE}  = "one year old";
        $self->{COLOR}= "green";
        $self->burninate;
    }
    print "Trogdor::_init got called\n";
}

sub awaken {
    my $self = shift;
    ($self->get_name eq "nameless") ? print "A " : 0;
    print $self->get_name .", ";
    ($self->get_name ne "nameless") ? print "an " : 0;
    print $self->get_age .", ";
    print $self->get_color ." dragon awakens from his slumber!(from Tr
+ogdor)\n";
}

sub burninate {
    my $self = shift;
    return $self->get_name ." burninates the land!\n";
}
1;

[download]
dragons.pl 
#!/usr/bin/perl
use strict;
use Trogdor;

#my $d = new Dragon();          # create a nameless dragon
#my $d = new Dragon("Smaug");   # create a dragon named Smaug
my $d = new Trogdor();          # create Trogdor
print $d->get_color;            # confirm Trogdor's color is reset

[download]

Thanks,

AH

---------- 
Using perl 5.8.1-RC3 unless otherwise noted.
Apache/1.3.33 (Darwin) unless otherwise noted.
Mac OS X 10.3.9 unless otherwise noted.

[download]

Replies are listed 'Best First'.
Re: oo design q: SUPER::_init
by lestrrat (Deacon) on Feb 18, 2006 at 01:03 UTC

    one way to do it is to use named parameters

      package Dragon;

  sub _init
  {
     my $self = shift;
     my %args = @_;
     foreach my $key qw(NAME AGE COLOR) {
        $self->{$key} = $args{$key};
     }
     $self->awaken();
  }

  package Trogdor;
  
  sub new
  {
     my $class = shift;
     $class->new(@_,
        NAME  => "Trogdor",
        AGE   => "one year old";
        COLOR => "green");
  }

    [download]

    If the values are overridable, put @_ at the end of the parameter list.

[reply]
[d/l]

      No, you miss my point. If you use named parameters, you can use the code that I posted.

[reply]

        Shoot. You're right. I misunderstood your example.

        And yours has the advantage of making it harder for the user to screw up the assignment by passing the arguments out of order (that is to say, there is no order if they're passed as named arguments).

        ---------- 
        Using perl 5.8.1-RC3 unless otherwise noted.
Apache/1.3.33 (Darwin) unless otherwise noted.
Mac OS X 10.3.9 unless otherwise noted.

        [download]
[reply]
[d/l]

      Thanks to both of you for your help. Incidentally, lestrrat, there is a minor error in your (elegant) solution: my %args = @_; assigns to the hash keys, so the foreach loop $self->{key} = $args{$key} actually assigns a null value to $self->{key}.

      I mention this just in case someone else grabs this code in the future and spends a few minutes scratching their head, like I did. Luckily, the fix is even simpler: 

      package Dragon

sub _init {
    my $self = shift;
    foreach my $key qw(NAME AGE COLOR) {
        $self->{$key} = shift;
    }
}

      [download]

      In the unlikely event that anyone is interested, my complete code follows:

      Read more... (2 kB)

      AH

      ---------- 
      Using perl 5.8.1-RC3 unless otherwise noted.
Apache/1.3.33 (Darwin) unless otherwise noted.
Mac OS X 10.3.9 unless otherwise noted.

      [download]
[reply]
[d/l]
[select]
Re: oo design q: SUPER::_init
by alienhuman (Pilgrim) on Feb 18, 2006 at 00:57 UTC

    After typing all that, I think my real question is: any reason not to put awaken() in the constructor?

    AH

    ---------- 
    Using perl 5.8.1-RC3 unless otherwise noted.
Apache/1.3.33 (Darwin) unless otherwise noted.
Mac OS X 10.3.9 unless otherwise noted.

    [download]
[reply]
[d/l]

      From what I can see, no. No reason whatsoever. That's not to say that lestrrat's suggestion doesn't have some merit as well, although lestrrat is missing the SUPER:: in front of the embedded new, I believe: 

        $class->SUPER::new(...);

      [download]
      Personally, I'd do both. It allows the maximum in flexibility, while not really costing much.

[reply]
[d/l]

Back to Seekers of Perl Wisdom