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

Is there some reliable way that a subroutine can gain access to itself as a code reference? I can do this as a closure but I wondered if there was something generalizable so any subroutine, closure or not, could alter itself.

I'm specifically thinking of subroutines that can terminate themselves and prevent further access. Here's a code snippet where I'm hoping for something more general.

sub purse
  {
    my $balance = shift;
    my $sub;
    $sub = sub { my ($who, $qty) = @_;
                 print "Paying $who $qty\n"
                   if ($balance - $qty) >= 0;
                 undef $sub
                   if $balance <= 0 };
  }

{
  my $payment = purse(10);
  for ([qw/mom 7/],
       [qw/dad 3/],
       [qw/myself 1/])
    {
      $payment->(@$_) if $payment;
    }
}

[download]

Replies are listed 'Best First'.
•Re: Giving subroutines access to themselves
by merlyn (Sage) on Dec 17, 2002 at 19:23 UTC
    I recall suggesting at least once or twice that some form of caller return back a coderef to the currently operating subroutine. Not implemented yet. I bet there's something in the Devel:: space that can do it though.

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

[reply]

      Oh right! I'd completely forgotten about Devel::Caller. It does just that. Thanks for reminding me.

[reply]
Re: Giving subroutines access to themselves
by MarkM (Curate) on Dec 17, 2002 at 19:38 UTC

    Your subroutine undef's $sub, but it does not undef $payment. In fact, without magic, $payment cannot be automatically undefined. Even if you had a reference to your code, it would be a copy of the reference, and manipulating the copy would not affect other copies.

    Assuming that there was no other way to accomplish what you want (i.e. you really need to be able to have a subroutine undef itself), try introducing another level of reference, such that $payment is a reference to a reference that you control. For example: (modified from your original code)

    sub purse
{
    my $balance = shift;
    my $coderef;
    $coderef = sub {
        my($who, $qty) = @_;
        print "Paying $who $qty\n"
            if ($balance - $qty) >= 0;
        undef $coderef
            if $balance <= 0
    };

    # Return a reference to your code reference.
    \ $coderef;
}

{
    my $$payment = purse(10);
    for ([qw/mom 7/],
         [qw/dad 3/],
         [qw/myself 1/])
    {
        $$payment->(@$_) if $$payment;
    }
}

    [download]
[reply]
[d/l]

      Details, details. *grin*

[reply]
Re: Giving subroutines access to themselves
by BrowserUk (Patriarch) on Dec 17, 2002 at 19:55 UTC

    No need for Devel::* 

    sub t1{ return "t1:",\&t1; }
sub t2{ *t2=\&t1 if @_; return "t2:",\&t2; }

print t1(), t2();
t1: CODE(0x1bd2940) t2: SCALAR(0x1bd53c8)

print t1(), t2();
t1: CODE(0x1bd2940) t2: SCALAR(0x1bd53c8)

print t1(), t2(), t2('change it');
Subroutine t2 redefined at (eval 47) line 1, <> line 50.
t1: CODE(0x1bd2940) t2: SCALAR(0x1bd53c8) t2: SCALAR(0x1bd53c8)

print t1(), t2();
t1: CODE(0x1bd2940) t1: CODE(0x1bd2940)

    [download]

    Update: Or per your example 

    sub t1{ return "t1:",\&t1; }
sub t2{ undef *t2 if @_; return "t2:",\&t2; }

print t1(), t2();
t1: CODE(0x1bd5200) t2: CODE(0x1bd5410)

print t1(), t2();
t1: CODE(0x1bd5200) t2: CODE(0x1bd5410)

print t1(), t2(), t2('change it');
t1: CODE(0x1bd5200) t2: CODE(0x1bd5410) t2: CODE(0x1bd52d8)

    [download]

    Examine what is said, not who speaks.

[reply]
[d/l]
[select]
Re: Giving subroutines access to themselves
by jdporter (Paladin) on Dec 17, 2002 at 19:34 UTC
    If you don't mind violating strict temporarily (or perhaps I should say, locally), you can do it like this: 
      sub foo {
    my @c = caller(0);
    no strict;
    *{ $c[3] } = sub { new_definition_for_foo...; };
  }

    [download]

    jdporter
    ...porque es dificil estar guapo y blanco.

[reply]
[d/l]
Re: Giving subroutines access to themselves
by dpuu (Chaplain) on Dec 17, 2002 at 20:18 UTC
    An alternative approach is to use objects, and bless.

    Imagine an Account class (an abstract base). Create two subclasses: ActiveAccount and DisabledAccount. You can now create 

      ActiveAccount::disable
  {
    my ($self) = @_;
    bless $self, "DisabledAccount";
  }

    [download]
    The reblessed object will no longer have access to the methods in ActiveAccount. --Dave
[reply]
[d/l]
Re: Giving subroutines access to themselves
by djantzen (Priest) on Dec 17, 2002 at 19:35 UTC

    I agree this is a nifty idea, but if all you want is to refuse to do something if certain conditions are met, what's wrong with: 

    return if $balance <= 0;

    [download]

    Why is it necessary to blow the subroutine away?

[reply]
[d/l]

      It's a bit more about revoking the method. I think that if I were to write self-revoking subroutines that I'd be operating in an environment where an object returns a method (read capability) keeping a copy of the object and itself as a closure. This is what an object revoking access from another object might look like. Or maybe not. Anyhow this is just a tool - whether it's a particularly good one or not... I don't know yet.

[reply]

Back to Seekers of Perl Wisdom