覆盖模块中定义但在运行时阶段使用的函数？

Question

让我们做一个非常简单的事情，

# Foo.pm
package Foo {
  my $baz = bar();
  sub bar { 42 };  ## Overwrite this
  print $baz;      ## Before this is executed
}

无论如何，我可以从test.pl运行代码中更改$baz设置并导致Foo.pm在屏幕上打印其他内容吗？

# maybe something here.
use Foo;
# maybe something here

在编译器阶段是否可以强制上述内容打印7？

Answer 1

之所以需要骇客，是因为require（因此use）在返回之前都编译并执行了模块。

同样适用eval。eval在不执行代码的情况下不能用于编译代码。

我发现的最不干扰的解决方案是重写DB::postponed。在评估已编译的所需文件之前将调用此方法。不幸的是，它仅在调试（perl -d）时调用。

另一个解决方案是读取文件，对其进行修改并评估修改后的文件，类似于以下内容：

use File::Slurper qw( read_binary );

eval(read_binary("Foo.pm") . <<'__EOS__')  or die $@;
package Foo {
   no warnings qw( redefine );
   sub bar { 7 }
}
__EOS__

上面的设置不正确%INC，它弄乱了警告使用的文件名，例如，它不会调用DB::postponed，等等。以下是更可靠的解决方案：

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;

我UNITCHECK之所以使用它（是在编译后但在执行之前调用的），是因为我在重写之前（使用unread）而不是在其中读取整个文件并附加新定义。如果要使用该方法，则可以使用返回文件句柄

open(my $fh_for_perl, '<', \$modified_code);
return $fh_for_perl;

@Grinnz提到@INC钩子表示由衷的感谢。

Answer 2

由于这里唯一的选择将非常棘手，因此我们真正想要的是在将子例程添加到%Foo::存储中之后运行代码：

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;

Answer 3

这将发出一些警告，但显示7：

sub Foo::bar {}
BEGIN {
    $SIG{__WARN__} = sub {
        *Foo::bar = sub { 7 };
    };
}

首先，我们定义Foo::bar。它的值将由Foo.pm中的声明重新定义，但是将触发“ Subroutine Foo :: bar redefined”警告，该警告将调用再次重新定义该子例程的信号处理程序以返回7。

Answer 4

这是一个结合了挂钩模块加载过程和Readonly模块的readonly-make功能的解决方案：

$ cat Foo.pm 
package Foo {
  my $baz = bar();
  sub bar { 42 };  ## Overwrite this
  print $baz;      ## Before this is executed
}


$ cat test.pl 
#!/usr/bin/perl

use strict;
use warnings;

use lib qw(.);

use Path::Tiny;
use Readonly;

BEGIN {
    my @remap = (
        '$Foo::{bar} => \&mybar'
    );

    my $pre = join ' ', map "Readonly::Scalar $_;", @remap;

    my @inc = @INC;

    unshift @INC, sub {
        return undef if $_[1] ne 'Foo.pm';

        my ($pm) = grep { $_->is_file && -r } map { path $_, $_[1] } @inc
           or return undef;

        open my $fh, '<', \($pre. "#line 1 $pm\n". $pm->slurp_raw);
        return $fh;
    };
}


sub mybar { 5 }

use Foo;


$ ./test.pl   
5