An alternate design is to derive from Foo::Parse.

package Foo::Parse;

#...

sub parse {
  my $self = shift;
  if (my $func = $self->can('action'))
  {
    $self->$func(@_);
  }
}

#...

package Foo::Parse::Splitter

use base 'Foo::Parse';

sub action {
  my $self = shift;
  # ...
}

package main;

my $fp = Foo::Parse::Splitter->new('FooParser');
$fp->parse($_) while <>;
[download]

my $fp;
$fp = Foo::Parse->new('FooParser',
  sub {
    local $_ = shift;
    s/^\w+:// or
      $fp->warn("something wrong!");
    split /,/;
  } );
[download]

Note that $self in the callback doesn't make much sense


Well - yes and no. Without the $self certainly works as you have it, but it is much easier to use $self. $self in this case is simply the topic of discussion - the guy who called the method - even if he isn't the one who owns the method. Using the callback as a method also allows the following to work without the predeclared "my $fp".



my $fp = Foo::Parse->new('Fooparser', \&Some::Other::Class::Method);
[download]


You can call the Some::Other::Class::Method with any object that "does" everything that Method requires. This will be easier to validate for in Perl 6 as even the anonymous method can have a signature that can make sure that whatever gets passed to it has the appropriate capabilities.


my @a=qw(random brilliant braindead); print $a[rand(@a)];

An alternate design is to derive from Foo::Parse.

Interesting approach, but I was specifically interested in callbacks in this case. And -FWIW- in my real world program it's not to be a single sub, but a dispatch table...

Note that $self in the callback doesn't make much sense - it's a Foo::Parse object, and the callback is not a method of Foo::Parse. Better to name it $obj or $fp.

Very good point, in fact I've been lucubrating for a while as for what a good name for what I eventually called $self may have been. Incidentally in my real world program it will be a more descriptive name, like $log, so no problem here. As far as generic use is concerned, $obj is fine IMHO.

my $fp;
$fp = Foo::Parse->new('FooParser',
  sub {
    local $_ = shift;
    s/^\w+:// or
      $fp->warn("something wrong!");
    split /,/;
  } );
[download]

This makes it into a closure, meaning that $fp remains visible. Even if $fp were itself no longer in scope, this closure can still see it. This is even more normal to me.

Very good point too! I like closures, I just hadn't thought of this possibility...

I realised you were looking for callbacks, but given the number of questions here that are of the form "I want to do X, here's my solution for Y - what's wrong?", I like to give MTOWTDI - just incase what you really want is another WTDI.

Now, on to that last code snippet you quoted. I often mix my inheritance with callbacks. For example, the code I posted in Re: String expansion script is in one of my base objects from which many other object types are derived. In general usage, I call it like this:

  my @strings = $self->expand_string($foo);
[download]

In this module, I'll have my very own expand_variable function which expands the way I want (and usually it defers to $self->SUPER::expand_variable if it can't figure it out). However, in certain cases, I want access to variables that I don't want generic access to - or, perhaps, I can't have generic access to. So I put it my own closure:

  my @strings = $self->expand_string($foo, sub {
    /^VAR1$/ && return $blah;
    /^VAR2$/ && return @some_list;
    $self->expand_variable()
  } );
[download]

This works pretty much everywhere. $blah, @some_list, and $self are all scoped variables for the closure. And even if the current type doesn't have an expand_variable, that's ok since it is derived off the base with default variable handling.

So, from here, there's another minor point I would make with the code you started with: rather than passing in the variable, is it unreasonable to use $_? You may notice my expand_string code does that with do {local $_ = $var; $self->$func()}. I'm not sure which is faster, localising a global, or passing in a parameter. However, that's not why I'm doing it. I'm doing it because it allows your closure to be smaller because so many of perl's functions assume $_ when not given anything else - exactly why you were using "local $_ = shift" in the first place. I'm just suggesting generalising it so that all closures can gain from the behaviour.

sub parse {
    my $self=shift;
    my $meth = $self->{_action} || die "Missing action";
    $self->$meth(@_);
}
# it might be better to do this once in the new
# and then call it the way you have it
# I normally check every time as the penalty is low
# and I then know for sure I still have an action.
[download]

The only thing I normally do different in cases like this would be the following:

sub parse {
    my $self=shift;
    my $meth = $self->{_action} || die "Missing action";
[download]

Well, of course I actually do validate my input in real code, I only wanted my minimal example to stay really... ehm, minimal!

As a side note I would have done the validation in the constructor (or wherever the subref is actually passed in), and I would have checked that it is a subref.

$self->$meth(@_);
[download]

Just woke up in the morning, but... shouldn't that be

$meth->(@_);
[download]

instead?

This is among some of the coolest aspects of perl, IMO.

Assuming $meth is a coderef, $self->$meth(@_) is exactly the same as $meth->($self, @_). However, if $meth is a string which holds the name of a function, then they aren't the same. The rules get a bit convoluted here:

• $meth->($self, @_) does not work with strictures. Without strictures, it should only look in the current package for a function named as per $meth, and then is the same as $self->__PACKAGE__::$meth(@_) (if that is even legal code).
• $self->$meth(@_) does work with strict. It uses standard inheritance rules to find the function named as per $meth, which means starting with the package named as per "ref $self" and going up the @ISA tree.

This means that your validation should not check merely that the action parmaeter is a coderef, but also that $self can do it:

  $self->{_action} = ref $_[0] ? $_[0] : $self->can($_[0]);
  die "Invalid action" unless $self->{_action};
[download]

If you're passed a coderef, use it. If not, you can convert it into a coderef that has already gone through the @ISA tree to find the right function.

Any alternative suggestion? How is this kind of things generally done?

It's usually cleaner to demote the object's data to a separate class owned by the parent object, or even just to a single data structure owned by the parent object:

Instead of this:

    package Parent_object;
    
    sub new {
        my $O = bless {}, shift;
        
        $O->{'attribute-1'} = "value 1";
        $O->{'attribute-2'} = "value 2";
        $O->{'attribute-3'} = "value 3";
        [...]
        
        return ($O);
    }
[download]

do this:

    package Parent_object;
    
    sub new {
        my $O = bless {}, shift;
        
        $O->{'data'} = _fill_attributes (@_);
        
        return ($O);
    }
    
    sub _fill_attributes {
        my $result = {};
        
        $result->{'attribute-1'} = $_[0];
        $result->{'attribute-2'} = $_[1];
        $result->{'attribute-3'} = $_[2];
        [....]
        
        return ($result);
    }
[download]

By demoting the data, you get rid of the circular dependency between the parent object and the user-supplied child function. The child function doesn't need to know anything at all about the parent object, it only needs to know the data object, or hash, or whatever. Instead of calling your child functions like so:

    package Parent_object;
    
    [...]
    
    sub do_something {
        my $O = shift;
        
        my $f = $O->{'sub-function-for-this-case'};
        $f->($O);
        
        return ([whatever]);
    }
[download]

You can just pass the data:

    package Parent_object;
    
    [...]
    
    sub do_something {
        my $O = shift;
        
        my $f = $O->{'sub-function-for-this-case'};
        $f->($O->{'data'});
        
        return ([whatever]);
    }
[download]

It may not look like that big a change, but it gets rid of chicken-and-the-egg problems that can drive you absolutely nuts at design time.

It's usually cleaner to demote the object's data to a separate class owned by the parent object, or even just to a single data structure owned by the parent object:

Thank you for being so kind and take the time to answer my question. I'll take your advice into account, but still I fail to see how it can be related, if not marginally, to what I was asking...

Instead of this:

<SNIP>

do this:

    package Parent_object;
    
    sub new {
        my $O = bless {}, shift;
        
        $O->{'data'} = _fill_attributes (@_);
        
        return ($O);
    }
    
    sub _fill_attributes {
        my $result = {};
        
        $result->{'attribute-1'} = $_[0];
        $result->{'attribute-2'} = $_[1];
        $result->{'attribute-3'} = $_[2];
        [....]
        
        return ($result);
    }
[download]

I see what you mean, but...

By demoting the data, you get rid of the circular dependency between the parent object and the user-supplied child function. The child function doesn't need to know anything at all about the parent object, it only needs to know the data object, or hash, or whatever.

OTOH Tanktalus' solution with a closure is just as fine in avoiding that kind of "circular dependency" and is more close to "the way I want to do it". And it can still apply to the code you supplied, since it has to do with the subs that get passed in, not to what's in the objects that will use them. So the two issues are mostly orthogonal, IMHO...