You're just attempting to use regular inheritance, which Perl will handle for you quite happily.

Just for kicks:

#!/usr/bin/perl -w

use strict;

package Base;

sub defaults {
    warn "Doing defaults!\n";
}

package Child;

@Child::ISA = 'Base';

sub new {
    bless({}, $_[0]);
}

package main;

my $c = Child->new();
for (qw( SUPER::defaults defaults Base::defaults )) {
    if (defined( my $sub = $c->can($_) )) {
        warn "\$c can do $_!\n";
        $c->$sub();
    } else {
        warn "\$c cannot do $_.\n";
    }
}
[download]

The weird thing, however, is that the result of using SUPER depends on the package where you use it and not on the object instance. I modified chromatic's code to demonstrate this:

use strict;
package A;

sub new {
    my $pkg = shift;
    bless {}, $pkg;
}

sub first {
    print "A::first\n";
}

sub second {
    print "A::second\n";
}
sub check {
    my $this = shift;
    my $pkg = ref $this;
    print "\nResults of check:\n";
    foreach my $subname (qw(first SUPER::first second SUPER::second)) 
+{
        if (defined (my $sub = $this->can ($subname))) {
            print ("$pkg can $subname\n");
            $this->$sub ();
        }
        else {
            print "$pkg cannot do $subname\n";
        }
    }    
}


package A_sub;
@A_sub::ISA = qw(A);

sub first {
    print "A_sub::first\n";
}    

sub check_sub {
    my $this = shift;
    my $pkg = ref $this;
    print "\nResults of check_sub:\n";
    foreach my $subname (qw(first SUPER::first second SUPER::second)) 
+{
        if (defined (my $sub = $this->can ($subname))) {
            print ("$pkg can $subname\n");
            $this->$sub ();
        }
        else {
            print "$pkg cannot do $subname\n";
        }
    }    
}


package main;
my $asub = new A_sub;
$asub->check ();
$asub->check_sub ();
[download]

This prints:

Results of check:
A_sub can first
A_sub::first
A_sub cannot do SUPER::first
A_sub can second
A::second
A_sub cannot do SUPER::second

Results of check_sub:
A_sub can first
A_sub::first
A_sub can SUPER::first
A::first
A_sub can second
A::second
A_sub can SUPER::second
A::second
[download]

Did everybody out there know this? I was quite surprised of the result.

pike

Suprising yes. Weird only sortof. This is documented behaviour, if a little counter intuitive:

If you're trying to control where the method search begins and you're executing in the class itself, then you may use the SUPER pseudo class, which says to start looking in your base class's @ISA list without having to name it explicitly:

    $self->SUPER::display('Height', 'Weight');
[download]

Please note that the SUPER:: construct is meaningful only within the class.

from PerlObj, emphasis added

My guess why, and its only a guess, is that Perl resolves SUPER at compile time. It doesnt care about the object at all as that happens at runtime. OTOH, that explanation gives me a funny feeling, @ISA is being set at runtime so I am confused.

Yves
--
You are not ready to use symrefs unless you already know why they are bad. -- tadmc (CLPM)

$ ./test.pl
score: 0
vx: -1
symbol: _
[download]

shown: 1
score: 0
x: 0
vx: -1
y: 0
vy: 0
symbol: _
[download]

#!/usr/local/bin/perl
package Object;
use strict;

sub new {
    my ($proto, %args) = @_;
    my $class = ref $proto || $proto;
    my $self = bless {}, $class;
    $self->init(\%args);
    return $self;
}

sub init {
    my ($self, $args) = @_;
    my $defaults=$self->defaults;

    if (ref($defaults)) {
        # This is technically Ok because you are getting
        # defualts from yourself and accordingly the key=>values
        # should be correct
        @{$self}{keys %$defaults}=@{$defaults}{keys %$defaults};
    }
    # If %args are given to new(), use those instead
    # Unfortunately this is technically bad practice, as the
    # key=>values will not be coming from yourself (in an abstract sen
+se)
    # accordingly you really should implement code to determine if
    # the passed keys are in the set of allowed keys.
    # one way to do this is to make method calls for all legal attribu
+tes
    # and then use the keyname as the methodname. If the arg is not le
+gal
    # perl will throw a runtime error that the method is not found
    # leaving it as is is asking for hard to identify bugs.
    # something like this might be in order:
    #    $self->$_($args->{$_}) foreach keys %$args;

    @{$self}{keys %$args}=@{$args}{keys %$args};
    return $self;
}

1;


package Mover;
#use Object;
our @ISA = qw(Object);
use strict;

sub defaults {
    my $self=shift;
    my $defaults = {
        'symbol' => '?',     # override this in subclasses
        'x'      => 0,       # x-coordinate
        'y'      => 0,       # y-coordinate
        'vx'     => 0,       # velocity in x-direction
        'vy'     => 0,       # velocity in y-direction
        'shown'  => 1,       # still alive?
    }
}

1;


package Player;
#use Mover;
use strict;
our @ISA = qw(Mover);

sub defaults {
    my $self=shift;
    my $defaults =$self->SUPER::defaults();
    @{$defaults}{'symbol','score'}=('_',0);
    return $defaults;
}

1;
use strict;
use warnings;
#use Player;
my $player = Player->new('vx' => -1);
for (keys %$player) {
    print "$_: ", $player->{$_}, $/;
}

1;
[download]

HTH

Yves
--
You are not ready to use symrefs unless you already know why they are bad. -- tadmc (CLPM)

I think you can make this work as well as make the code much simpler; others have shown ways to make this work but I didn't think they simplified the code enough :). For example:

package Player;
#[...]
sub defaults {
    my $self= shift;
    return
        $self->SUPER::defaults(),
        'symbol'   => '_',
        'score'    => 0,
}
#[...]
package Mover;
#[...]
sub defaults {
    my $self= shift;
    return
        $self->SUPER::defaults,
        'symbol' => '?',     # override this in subclasses
        'x'      => 0,       # x-coordinate
        'y'      => 0,       # y-coordinate
        'vx'     => 0,       # velocity in x-direction
        'vy'     => 0,       # velocity in y-direction
        'shown'  => 1,       # still alive?
}
#[...]
package Object;
#[...]
sub defaults {
    return;
}
sub init {
        my ($self, $args) = @_;
        my ($defaults)= { $self->SUPER::defaults() };
        @{$self}{keys %$defaults}= values %$defaults;
        # If %args are given to new(), use those instead
        @{$self}{keys %$args}= values %$args;
}
[download]

By having an empty defaults() method in the base class, you don't have to call can(). By returning lists rather than references to hashes, you make merging while giving the inherited class precendence trivial (normally I avoid returning lists because I want to allow for cases where the list becomes really huge, but an object with a really huge list of default attributes seems unwise so the code simplicity seems like a net win).

Also, I didn't like your idea of using my and not return when what your routine was doing was just returning a value.

BTW, I applaud your technique of putting extra code in the base class to make the writing of defaults() methods as simple as possible. Unfortunately, the amount of additional code that would be required to make that actually work doesn't seem like a good trade-off to me; which would be basically rewriting can().

Well, the list approach is what I would consider to be 'thinking outside of the box'. I see a hash and I think how to manipulate it. But as you have shown what I really should have been thinking is 'do you even need to pass around a hash at all?'. Also, Im not really sure why, but even though I know the list to hash idea, and use it occasionally, I almost never use it to kill duplicates, another example of getting stuck inside the box. :-) Again on a similar note I must must must remember that wonderful keyword values(). I use keys() all the time, but almost never use values().

What all this comes to is one of the most fascinating things about Perl. Even though you know ten ways to do things, and do them regularly, theres alway a command, module, or tactic (for lack of a better word) lurking off to the side of box. Occasionally you notice the item on your own, either through research or luck, but more often because someone elses box contained the item center stage. Which brings me to perlmonks. This is the place where you are practically guaranteed to learn something new, every day. And thats cause there are a bunch of people here who seem to think outside the box pretty often.

Thanks for the lesson Tye, chromatic (umm, everyone else as well :-) and good question kwof.

Yves
--
You are not ready to use symrefs unless you already know why they are bad. -- tadmc (CLPM)

Class Hiearchy:
Object
Mover
Player
main

I disagree:

#!/usr/bin/perl -w

use strict;

package Obj;

sub new {
    bless({}, $_[0]);
}

sub can {
    my $self = shift;
    warn "Called can in Obj.n";
    $self->SUPER::can(@_);
}

package main;

my $o = Obj->new();
print $o->can('new'), "\n", UNIVERSAL::can($o, 'new'), "\n";
[download]

And just to be dangerous (it's cheaper than a motorcycle):

package UNIVERSAL;

sub new {
    bless({}, $_[0]);
}

sub loop {
    my $self = shift;
    $self->SUPER::loop();
}

package main;
Universal->new->loop();
[download]

Try to catch this before it eats up your memory.

Thanks for your replies. I summarize here.

I see the problem was that I thought the SUPER::defaults() method applied to the object it was called on. As noted by "Anonymous Monk", pike, and demerphq (who referenced `perldoc perlobj`), SUPER:: is relative to the package containing the SUPER:: construct and not the package of the object that called it.

It seems, then, that one would basically rewrite the functionality of can(), which tye said is probably not worth it. In fact, I like tye's solution, the goal being to simplify the coding of subclasses (why else use OO? :).

Finally, the (welcome) criticisms.

1. demerphq asked that I mention the parent classes before the subclasses. I apparently think upside-down. 8) (I just noticed the "d/l code" link, which pulls out the <CODE> sections; I assume that is part of the motivation.)
2. demerphq also mentioned checking that the subroutine arguments are allowed. I'll re-read those points in the "Object-Oriented Perl" book and try to figure it out.
3. I agree with tye's point that using `my` instead of `return` is stupid. Probably I'll end up creating a `my` variable and returning it, though.

Again, thanks for everyone's help.