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 have been in effect. 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:
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?
Tom Moertel : Blog / Talks / CPAN / LectroTest / PXSL / Coffee / Movie Rating Decoder
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:
- Does it work?
- Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
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.
Tom Moertel : Blog / Talks / CPAN / LectroTest / PXSL / Coffee / Movie Rating Decoder
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
Simpler, or did I miss something?The empty case:
print localize qw[], \&d; # Not a GLOB reference at line 14.
Tom Moertel : Blog / Talks / CPAN / LectroTest / PXSL / Coffee / Movie Rating Decoder
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:
- Does it work?
- Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
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 [http://creativecommons.org/licenses/publicdomain|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.
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.
Hugo
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
Tom Moertel : Blog / Talks / CPAN / LectroTest / PXSL / Coffee / Movie Rating Decoder
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
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.
@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/
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.