Let's take something very simple,
# Foo.pm
package Foo {
my $baz = bar();
sub bar { 42 }; ## Overwrite this
print $baz; ## Before this is executed
}
Is there anyway that I can from test.pl
run code that changes what $baz
is set to and causes Foo.pm
to print something else to the screen?
# maybe something here.
use Foo;
# maybe something here
Is it possible with the compiler phases to force the above to print 7
?
A hack is required because require
(and thus use
) both compiles and executes the module before returning.
Same goes for eval
. eval
can't be used to compile code without also executing it.
The least intrusive solution I've found would be to override DB::postponed
. This is called before evaluating a compiled required file. Unfortunately, it's only called when debugging (perl -d
).
Another solution would be to read the file, modify it and evaluate the modified file, kinda like the following does:
use File::Slurper qw( read_binary );
eval(read_binary("Foo.pm") . <<'__EOS__') or die $@;
package Foo {
no warnings qw( redefine );
sub bar { 7 }
}
__EOS__
The above doesn't properly set %INC
, it messes up the file name used by warnings and such, it doesn't call DB::postponed
, etc. The following is a more robust solution:
use IO::Unread qw( unread );
use Path::Class qw( dir );
BEGIN {
my $preamble = '
UNITCHECK {
no warnings qw( redefine );
*Foo::bar = sub { 7 };
}
';
my @libs = @INC;
unshift @INC, sub {
my (undef, $fn) = @_;
return undef if $_[1] ne 'Foo.pm';
for my $qfn (map dir($_)->file($fn), @libs) {
open(my $fh, '<', $qfn)
or do {
next if $!{ENOENT};
die $!;
};
unread $fh, "$preamble\n#line 1 $qfn\n";
return $fh;
}
return undef;
};
}
use Foo;
I used UNITCHECK
(which is called after compilation but before execution) because I prepended the override (using unread
) rather than reading in the whole file in and appending the new definition. If you want to use that approach, you can get a file handle to return using
open(my $fh_for_perl, '<', \$modified_code);
return $fh_for_perl;
Kudos to @Grinnz for mentioning @INC
hooks.
Since the only options here are going to be deeply hacky, what we really want here is to run code after the subroutine has been added to the %Foo::
stash:
use strict;
use warnings;
# bless a coderef and run it on destruction
package RunOnDestruct {
sub new { my $class = shift; bless shift, $class }
sub DESTROY { my $self = shift; $self->() }
}
use Variable::Magic 0.58 qw(wizard cast dispell);
use Scalar::Util 'weaken';
BEGIN {
my $wiz;
$wiz = wizard(store => sub {
return undef unless $_[2] eq 'bar';
dispell %Foo::, $wiz; # avoid infinite recursion
# Variable::Magic will destroy returned object *after* the store
return RunOnDestruct->new(sub { no warnings 'redefine'; *Foo::bar = sub { 7 } });
});
cast %Foo::, $wiz;
weaken $wiz; # avoid memory leak from self-reference
}
use lib::relative '.';
use Foo;
This will emit some warnings, but prints 7:
sub Foo::bar {}
BEGIN {
$SIG{__WARN__} = sub {
*Foo::bar = sub { 7 };
};
}
First, we define Foo::bar
. It's value will be redefined by the declaration in Foo.pm, but the "Subroutine Foo::bar redefined" warning will be triggered, which will call the signal handler that redefines the subroutine again to return 7.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With