Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

A general method of locally overriding subroutines

by tmoertel (Chaplain)
on Mar 11, 2006 at 02:21 UTC ( #535859=perlmeditation: print w/ replies, xml ) Need Help??

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" };
I can temporarily override the definition of a like so:
no strict 'refs'; no warnings 'redefine'; { local *a = sub { "changed" }; print_a(); # prints "changed" }
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"
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); }
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"
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); }
That seems simple enough. Unfortunately, the code does not work:
localize_and_call_fn( [qw(a b c)], \&print_a ); # prints "unchanged"
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" }; # }
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"
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)->(@_); # })->(@_) # })->(@_) # })->();
It seems like a roundabout way to accomplish what ought to be easy, but it works. Can you think of a better way?

Comment on A general method of locally overriding subroutines
Select or Download Code
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->(); }
    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?
      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->(); }
      Even so, it's easier to understand than the nested-subroutines solution.

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

        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

        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.
        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->(); }

        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?
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; }

    -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.

Re: A general method of locally overriding subroutines
by hv (Parson) 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); }

    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

      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); }
      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

      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); }

      Hugo

Re: A general method of locally overriding subroutines
by Arunbear (Parson) 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();
    output:
    a b c changed changed changed a b c Tool completed successfully

      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.

        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@/
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 ); } }

    Makeshifts last the longest.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://535859]
Approved by virtualsue
Front-paged by grinder
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (7)
As of 2014-07-14 03:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (254 votes), past polls