Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Overwriting a function defined in a module but before used in its runtime phase?

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?

like image 347
NO WAR WITH RUSSIA Avatar asked Oct 30 '19 18:10

NO WAR WITH RUSSIA


3 Answers

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.

like image 123
ikegami Avatar answered Nov 11 '22 21:11

ikegami


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;
like image 8
Grinnz Avatar answered Nov 11 '22 20:11

Grinnz


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.

like image 7
choroba Avatar answered Nov 11 '22 19:11

choroba