http://qs321.pair.com?node_id=535874


in reply to A general method of locally overriding subroutines

sub localize {
    my $real = pop;

    no strict 'refs';
    AGAIN: local *{shift@_} = sub { 'changed' };
    goto AGAIN if @_;
    $real->();
}

[download]
One of the few places that goto LABEL is useful.
My criteria for good software:
  1. Does it work?
  2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?

Replies are listed 'Best First'.
Re^2: A general method of locally overriding subroutines
by tmoertel (Chaplain) on Mar 11, 2006 at 05:33 UTC
    Clever. It just needs one more goto to handle the empty case (no overrides) gracefully: 
    sub localize {
    my $real = pop;
    no strict 'refs';
    goto CALL unless @_;
    AGAIN: local *{shift@_} = sub { 'changed' };
    goto AGAIN if @_;
    CALL: $real->();
}

    [download]
    Even so, it's easier to understand than the nested-subroutines solution.

    I wonder if anybody out there has got something even simpler.

    Tom Moertel : Blog / Talks / CPAN / LectroTest / PXSL / Coffee / Movie Rating Decoder

[reply]
[d/l]

      Simpler, or did I miss something? 

      #! perl -slw
use strict;

$, = ' ';

sub a{ 'a' }
sub b{ 'b' }
sub c{ 'c' }

sub d{ ( a, b, c ) };

sub localize {
    no strict 'refs'; no warnings 'redefine';
    A: local *{ +shift } = sub{ 'changed' };
    goto A if @_ > 1;
    +shift->();
}

print d;
print localize qw[a b c], \&d;
print d;
print localize qw[a c], \&d;
print d;
__END__
C:\test>junk
a b c
changed changed changed
a b c
changed b changed
a b c

      [download]
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[reply]
[d/l]
      Even so, it's easier to understand than the nested-subroutines solution.

      More importantly, the stackdump is more easily understood.

      I wonder if anybody out there has got something even simpler.

      I would hope there's something better than that. For one thing, my version doesn't allow each function to be a closure. Though, that's easy enough to fix, I suppose. 

      sub localize {
    my $real = pop;

    no strict 'refs'; no warnings 'redefine';
    goto CALL unless @_;
    AGAIN: my $v = shift;
    local *{$v} = do {
        my $v2 = $v;
        sub { "changed $v2" }
    };
    goto AGAIN if @_;
    CALL: $real->();
}

      [download]
      My criteria for good software:
      1. Does it work?
      2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
[reply]
[d/l]

In Section Meditations