A general method of locally overriding subroutines

While trying to embed a domain-specific language into Perl, I came across an interesting problem involving local subroutines. In this meditation, I will build up to the problem and then explain how I solved it. If you can think of a better solution, please let me know.

One trick that is useful in certain limited circumstances is to define (or redefine) a subroutine locally, in effect overriding any original definition that may exist. For example, let's say I have the following subroutines:

use warnings; 
use strict;

sub a       { "unchanged" };
sub print_a { print a(), "\n" };
[download]

I can temporarily override the definition of a like so:

no strict 'refs';
no warnings 'redefine';

{
    local *a = sub { "changed" };
    print_a();  # prints "changed"
}
[download]

The extent of the change is limited to the dynamic scope of the block in which the local-ized assignment is made. If I call print_a from outside of the block, its call to a will invoke the original "unchanged" definition:

print_a();      # prints "unchanged"
[download]

Let's say I want to do this kind of temporary overriding frequently. I can create a helper subroutine to make the process more convenient:

sub localize_a_and_call_fn(&@) {
    my ($fn, @args) = @_;
    local *a = sub { "changed" };
    $fn->(@args);
}
[download]

Now I can run any code I want within the scope where a is temporarily overridden:

localize_a_and_call_fn( \&print_a );
# prints "changed"

localize_a_and_call_fn {
    print "a() => ", a(), "\n";
};
# prints "a() => changed"
[download]

That's great.

But let's say I want to take it one step further (which, in fact, I did). Let's say I want to write a more general helper that lets me temporarily override any given list of subroutines – say a, b, and c. My first attempt went like this:

sub localize_and_call_fn
{
    my ($locals, $fn, @args) = @_;
    local *$_ = sub { "changed" } for @$locals;
    $fn->(@args);
}
[download]

That seems simple enough. Unfortunately, the code does not work:

localize_and_call_fn( [qw(a b c)], \&print_a );
# prints "unchanged"
[download]

The problem seems to be the for modifier on the simple statement that attempts to localize the given subroutines. Even though perlsyn does not say so, it appears that the simple statement to which the modifier is attached is evaluated within an implicit block, at least as far as local is concerned. It's as if the statement had been written like this:

#     for (@$locals) {
#         local *$_ = sub { "changed" };
#     }
[download]

None of the local changes can escape the for loop, and thus by the time the helper subroutine invokes $fn->(@args), the original definitions of a, b, and c have been restored. The invoked subroutine will never see the changes.

I could not think of any way to use a simple loop to make local changes for a given list of symbols. By using nested anonymous subroutines, however, I was able to do it. (One could also use explicit recursion.) Here's the code I used:

sub localize_and_call_fn_2
{
    my ($locals, $fn, @args) = @_;

    for my $sym (@$locals) {
        my $f = $fn;
        $fn = sub {
            local *$sym = sub { "changed" };
            $f->(@_);
        }
    }

    $fn->(@args);
}

localize_and_call_fn_2( [qw(a b c)], \&print_a );
# prints "changed"
[download]

The for loop in the new helper function wraps anonymous subroutines around the seed of code given in $fn. Each of the wrappers overrides a single symbol's definition and then passes control the next wrapper. The last wrapper invokes the original seed of code. In effect, the call to localize_and_call_fn_2 above gets converted into the following code:

# (sub {
#     local *c = sub { "changed" };
#     (sub {
#         local *b = sub { "changed" };
#         (sub {
#             local *a = sub { "changed" };
#             (\&print_a)->(@_);
#         })->(@_)
#     })->(@_)
# })->();
[download]

It seems like a roundabout way to accomplish what ought to be easy, but it works. Can you think of a better way?

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

Comment on A general method of locally overriding subroutines Select or Download Code

Replies are listed 'Best First'.
Re: A general method of locally overriding subroutines by dragonchild (Archbishop) on Mar 11, 2006 at 04:43 UTC
`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: Does it work? Can someone else come in, make a change, and be reasonably certain no bugs were introduced?	[reply] [d/l] [select]
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]
Re^3: A general method of locally overriding subroutines by BrowserUk (Patriarch) on Mar 11, 2006 at 06:36 UTC
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]
Re^4: A general method of locally overriding subroutines by tmoertel (Chaplain) on Mar 11, 2006 at 07:35 UTC
Re^3: A general method of locally overriding subroutines by dragonchild (Archbishop) on Mar 11, 2006 at 13:20 UTC
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: Does it work? Can someone else come in, make a change, and be reasonably certain no bugs were introduced?	[reply] [d/l]
Re: A general method of locally overriding subroutines by Arunbear (Prior) on Mar 11, 2006 at 13:40 UTC
There is a module that provides this facility: `use Sub::Override; use strict; use warnings; $, = ' '; $\ = "\n"; sub a{ 'a' } sub b{ 'b' } sub c{ 'c' } sub d{ ( a, b, c ) }; print d(); { my $override = Sub::Override->new; $override->replace(a => sub { "changed" }) ->replace(b => sub { "changed" }) ->replace(c => sub { "changed" }); print d(); } print d();` [download] output: `a b c changed changed changed a b c Tool completed successfully` [download]	[reply] [d/l] [select]
Re^2: A general method of locally overriding subroutines by xdg (Monsignor) on Mar 11, 2006 at 14:08 UTC
That's a really neat way to do it. I used a similar technique for File::pushd -- using an object to enact a localized change that is reverted when the object goes out of scope. -xdg Code written by xdg and posted on PerlMonks is public domain. It is provided as is with no warranties, express or implied, of any kind. Posted code may not have been tested. Use of posted code is at your own risk.	[reply]
Re^3: A general method of locally overriding subroutines by fizbin (Chaplain) on Mar 18, 2006 at 01:48 UTC
Isn't it nice to have deterministic behavior that fires when an object goes out of scope? I miss that when working in java. -- `@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/; map{y/X_/\n /;print}map{pop@$_}@/for@/` [download]	[reply] [d/l]
Re: A general method of locally overriding subroutines by xdg (Monsignor) on Mar 11, 2006 at 05:37 UTC
What worked for me in my experiments with localizing variables in Object::LocalVars is to build a string with all the `local` calls and then `eval it`. That would avoid the recursion. You could either include the function call and arguments in the `eval` directly or have the `eval` return just a single anonymous function that does all the localization and then the function call. As a side note, you can also use `local` in a list context like `my`, so you could try to build that eval string along these lines: `sub localize_and_call_fn { no strict 'refs'; no warnings 'redefine'; my ($locals, $fn, @args) = @_; my $new_fcn = sub { "changed" }; my $globs = join( q{,}, map { "$_" } @$locals); my $eval_text = << "END_EVAL"; local( $globs ) = ( \$new_fcn ) x \@\$locals; \$fn->(\@args); END_EVAL eval $eval_text; }` [download] -xdg Code written by xdg and posted on PerlMonks is public domain. It is provided as is* with no warranties, express or implied, of any kind. Posted code may not have been tested. Use of posted code is at your own risk.	[reply] [d/l] [select]
Re: A general method of locally overriding subroutines by hv (Prior) on Mar 11, 2006 at 09:41 UTC
Are the functions to be overridden all in the same package? ~~If they are, you can do the localisation with a single hash slice:~~ `sub localise_and_call { my($fn, @args) = @_; my $stash = \%::; # assuming main package # I forgot the local here @$stash{@args} = (sub { "changed" }) x @args; $fn->(@args); }` [download] Update: oops, doesn't work when I add the "local" where it's supposed to go. I'm not sure why not though, maybe a bug. Update: now reported as bug #38710. Hugo	[reply] [d/l]
Re^2: A general method of locally overriding subroutines by tmoertel (Chaplain) on Mar 11, 2006 at 16:56 UTC
I had tried the hash-slice method earlier, but it did not work when `local`-ized: `sub localize_and_call_fn { my ($locals, $fn, @args) = @_; local @::{@$locals} = (sub {"changed"}) x @$locals; $fn->(@args); }` [download] I figured I was doing something wrong, but I couldn't figure out where exactly the train had left the rails. Thanks for putting more light on the subject. Cheers, Tom Tom Moertel : Blog / Talks / CPAN / LectroTest / PXSL / Coffee / Movie Rating Decoder	[reply] [d/l]
Re^2: A general method of locally overriding subroutines by hv (Prior) on Mar 20, 2006 at 10:59 UTC
Update: this bug has now been fixed for perl-5.10 (change #27547), and I think it is likely the fix will make it into one of the next maintenance releases (5.8.9 or 5.8.10) as well. So you will be able to write: `sub localise_and_call { my($fn, @args) = @_; my $stash = \%::; # assuming main package local @$stash{@args} = (sub { "changed" }) x @args; $fn->(@args); }` [download] Hugo	[reply] [d/l]
Re: A general method of locally overriding subroutines by Aristotle (Chancellor) on Jul 19, 2006 at 05:34 UTC
Is it me, or did everyone miss the simplest approach? `sub localize_and_call_fn { my ( $locals, $fn, @args ) = @_; if( @$locals ) { my ( $sym, @local ) = @$locals; local $sym = sub { "changed" }; @local ? localize_and_call_fn( \@local, $fn, @args ) : $fn->( +@args ); } }` [download] Makeshifts last the longest.*	[reply] [d/l]

Back to Meditations