I think there was a p5p discussion about this a few weeks back, but it's not likely to be solved in the near future.

Update: I'm not sure that answers your question, partly because I'm not sure of your question. Is something preventing you from using the normal inheritance mechanism which takes care of this automatically? If so, perhaps your object model could use some rethinking.

You aren't the only person that didn't understand me, so it must be my fault. I did fumble a bit with the wording when I was trying to spit it out, so let me try again.

The main issue is that I have one superclass that might be subclassed by four or five classes, and each of those might be subclassed by four or five classes. Each class at each level needs to implement do_something(). So, if I have A::B::C, then there needs to be a C::do_something, B::do_something, and A::do_something. Additionally, C::do_something needs to recursively call B::do_something, etc.. Also, I want the external behavior of my API to be alike for all of the do_something methods. Somebody using my group of modules should not need to know if they are presently using an A::B::C object or an A::B::D object, all they need to know is that $object->do_something() will do something consistently for all objects that inherit from A.

What I have discovered is that in my case, the only difference between each of the do_something methods are a couple of constants that I already know at compile time.

If the only thing that makes each of the methods different is a couple of constants, I was hoping that I could use closures to generate my code for me in each module, rather than having to implement a stub for the method in every module.

I'm sure a good bit of the confusion stems from my lack of experience with closures. So please accept my appologies for that. Hopefully I've explained myself better this time.

the only difference between each of the do_something methods are a couple of constants that I already know at compile time.

It matters who knows these constants. If these are only known in the "final" classes, then you can use a single do_something() inherited from the parent class, and then arrange for each of the specializing classes to provide methods to return the constants.

Let's consider a simple "B inherits from A" case.

  package A;

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

  sub do_something {
      my $self = shift;

      my $n = $self->x() + $self->y();
      print "something is $n\n";
  }

  sub x { die "subclass must override x\n" }
  sub y { die "subclass must override y\n" }

  package B;

  @ISA = (A);

  sub x { 42 }
  sub y { 47 }

  package main;

  my $object = new B();
  $object->do_something;
  # A::do_something invokes B::x and B::y
[download]

This adapts easily to multiple levels of inheritance. For example, the first level of inheritance can override x() and the next level can override y().

An alternative is to stuff the constants into the object's hash at initialization time.

  package A;

  sub new {
      my $pkg = shift;
      my $self = bless {}, $pkg;
      $self->init();
  }

  sub init { die "subclass must override init()\n" }

  sub do_something {
      my $self = shift;
      my $n = $self->{x} + $self->{y};
      print "something is $n\n";
  }

  package B;

  @ISA = (A);

  sub init {
    my $self = shift;
    $self->{x} = 42;
    $self->{y} = 47;
  }

  package main;

  my $object = new B();
  $object->do_something();
  # A::do_something reaches into the bag, and pulls out
  # numbers that B::init provided
[download]

In both cases, you could provide default behavior in the superclass.

Therefore to do what you are trying you need to actually compile it in the package that you want. So you can still do what you want, but you need to use a string eval to get it to work right.

For an example of the technique, complete with debugging hooks so that errors are reported from something more meaningful than just some eval, take a look at how I implemented AbstractClass. (Look at the end of perlsyn for an explanation of the #line business.)

#FILE Foo.pm
package Foo;
use strict;

__PACKAGE__->make_do_something();


sub make_do_something {
    my $class = shift;
    my $meth_name = "do_something";
    my $parent = $class->can($meth_name);

    no strict 'refs';
    *{"$class\::$meth_name"} = sub { 
        my $self = shift;
        if ($parent) {
            print "$class is not the root\n";
            $self->$parent(@_);
        }
        print "Foo $class!!!\n";
        return 1;
    };
}

1;
__END__


#FILE Bar.pm
package Bar;

use base 'Foo';
use strict;

__PACKAGE__->make_do_something(  );

sub new { 
    bless {}, shift();
}

1;

__END__


#FILE foobar.pl
#!/usr/local/bin/perl
#File: foobar.pl

use Foo;
use Bar;

$b = new Bar();
$b->do_something();

__END__
[download]

Hi, this is what I got to work:

package Foo;

# must use '\' to create the reference, and since it's a 
# reference not an invocation, we can't specify arguments 
# here. (see the .pl file at the end)

*do_something = \&make_do_something;

sub make_do_something {
    # make_do_something is the method called, hence the 
    # object reference will be on *this* @_, not the 
    # one below.
    my ($self, $name) = @_;
[download]

    return sub {
        if ( $name ne 'foo' ) {
            print "Not foo\n";
            $self->SUPER::do_something();
        }
        print "Foo $name!!!\n";
        return 1;
    }
}
1;


#File: Bar.pm

package Bar;
use base 'Foo';

*do_something = \&Foo::make_do_something;

sub new {
    bless {}, shift();
}

1;


#!/usr/local/bin/perl
use lib '.';
use Foo;
use Bar;

$b = new Bar();
# just calling do_something won't cause the subroutine 
# returned to execute; we've got to do that ourselves.

my $sub = $b->do_something('foo'); # supply args here, not above. stor
+e the subroutine ref
$sub->(); # dereference it to run it
[download]

If I understand you correctly, then I believe there are two problems with this,


1. This requires that the coder using my object knows about the internal details of my object, and that the coder always knows at run time exactly what kind of object they have. I want them to be able to do_something with any subclass of Foo without having to know which subclass it is.
2. I couldn't get your to work for me to work in all cases. When I modify the definition of $sub in the main package to call $b->do_something('bar'), I get the exact same error:

Not foo
Can't locate object method "do_something" via package "Foo"
 (perhaps you forgot to load "Foo"?) at ./foobar.pl line 20.

Instead, how about a more traditional polymorphic approach:

package Foo;

use strict;

sub new {
    bless {}, shift();
}

sub do_something {
   my $self = shift;
   my $name = shift || 'foo';
   return make_do_something($name);
}

sub make_do_something {
    my $name = shift;
    return sub {
        my $self = shift;
        print "Foo $name!!!\n";
    }
}

1;

##############################################

package Bar;

use strict;
use base 'Foo';

sub new {
    bless {}, shift();
}

sub do_something {
   my $self = shift;
   return $self->SUPER::do_something('bar');
}

1;
[download]

This is my test script. The big difference is that the do_something() method returns a code ref, so you need to add some syntax:

#!/usr/bin/perl -w

use strict;
use Foo;
use Bar;

$_->do_something()->() for (new Foo, new Bar);
[download]

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

If it were that simple, I'd be set :)

I'm sorry that I didn't make sense the first time. The issue is that I want to recursively call SUPER::do_something all the way up to the top most superclass that can do_something. I could do that like this:

package A;
sub do_something {
  print "Foo\n";
}

package B;
@ISA = ( A );
sub do_something {
  my $self = shift;
  $self->SUPER::do_something();
  print "Bar\n";
}
[download]

But, I'd end up with a whole bunch of stub modules sitting around that were all almost identical, save a literal constant ("Foo\n" vs. "Bar\n") and the fact that A does not call SUPER::do_something(). Shouldn't I be able to abstract this all away so that I only have to implement do_something() once and not worry about making stubs in all my modules? As I said, I'm not very experienced with closures, but I thought this is what they were all about. It would be more maintainable if I could change the requirements of do_something() in the future and NOT have to go change every one of my stubs.

I guess I should just suck it up and write the stubs.