In Perl, how can a subroutine get a coderef that points to itself?

Question

For learning purposes, I am toying around with the idea of building event-driven programs in Perl and noticed that it might be nice if a subroutine that was registered as an event handler could, on failure, just schedule another call to itself for a later time. So far, I have come up with something like this:

my $cb;
my $try = 3;
$cb = sub {
    my $rc = do_stuff();
    if (!$rc && --$try) {
        schedule_event($cb, 10); # schedule $cb to be called in 10 seconds
    } else {
        do_other_stuff;
    }
};
schedule_event($cb, 0); # schedule initial call to $cb to be performed ASAP

Is there a way that code inside the sub can access the coderef to that sub so I could do without using an extra variable? I'd like to schedule the initial call like this.

schedule_event( sub { ... }, 0);

I first thought of using caller(0)[3], but this only gives me a function name, (__ANON__ if there's no name), not a code reference that has a pad attached to it.

Answer 1

I think Sub::Current will fix your problem.

Answer 2

If you don't change $cb's value again, you can use that. If not, define a scalar to hold that and don't change it ever again. For example:

my $cb = do {
  my $sub;
  $sub = sub { contents using $sub here }
}

Answer 3

To get a reference to the current subroutine without using an extra variable, you can use a tool from functional programming, the Y-combinator, which basically abstracts away the process of creating the closure. Here is a perlish version:

use Scalar::Util qw/weaken/;

sub Y (&) {
    my ($code, $self, $return) = shift;
    $return = $self = sub {$code->($self, @_)};
    weaken $self;  # prevent a circular reference that will leak memory
    $return;
}

schedule_event( Y { my $self = shift; ... }, 0);

Answer 4

Using a fixed-point combinator, you can write your $cb function as if the first argument was the function itself:

sub U {
  my $f = shift;
  sub { $f->($f, @_) }
}

my $cb = sub {
  my $cb = shift;
  ...
  schedule_event(U($cb), 10);
  ...
}

schedule_event(U($cb), 0);