我可以在包中注入 perl 子程序吗？答案

【问题标题】：Can I inject a perl sub in a package?我可以在包中注入 perl 子程序吗？
【发布时间】：2020-01-07 10:56:50
【问题描述】：

我希望能够在类中动态“注入”方法，类似于 Mojolicious 助手的情况。像这样的：

my $s = SomeThing->new;

$s->helper(do_this => sub {
               my $self = shift;
               $foo = shift;
           });

$s->do_this('bar');

我已经取得了一些进展，但我希望被注入的 subs 在它们注入的类的命名空间中运行，而不是在 main 中运行。换句话说，目前的工作方式如下：

$s->do_this('bar');

print 'in main:      ', $foo;

这会打印“bar” - 我不希望它打印，而我希望 this

print 'in SomeThing: ', $SomeThing::foo;

改为打印“bar”

虽然这可行，但对我来说似乎很笨重

$s->helper(do_this => sub {
               my $self = shift;
               ${(ref $self) . '::foo'} = shift;
           });

$s->do_this('foo');

print 'in SomeThing: ', $SomeThing::foo;  # now this prints "foo"

发生这一切的包如下所示：

package SomeThing {
    use Mojo::Base -base;
    use Carp;

    sub helper {
        my $self = shift;
        my $name = shift || croak "The helper name is required";
        my $sub = shift || sub {};

        my $namespace = __PACKAGE__;
        no strict 'refs';
        { 
            *{"$namespace\::$name"} = $sub
        }
    }
};

有没有办法做到这一点？我怀疑我会搞砸严格性真的很糟糕 - 但我还不想放弃（这将是一个很好的学习技巧）。

【问题讨论】：

在您的用例中是否可以使用eval 从字符串生成代码？
提示：Re "*{"$namespace\::$name"} = $sub", *$name = $sub 在这里就足够了。
@pmqs 我想尽可能避免这种情况
我不清楚您是否希望注入的方法仅适用于该实例或任何实例
他们说的是“包”和“类”，而不是“对象”。

标签： perl mojolicious

【解决方案1】：

您要求更改与已编译的匿名子关联的包以进行变量查找。我不知道这是否可能。

即使有可能，您也不想这样做，因为您的代码仍然无法正常工作。您必须将 use vars qw( foo ); 添加到找到 sub { } 文字的文件中。如果您在Something.pm 中访问过它，那么除了使用our $foo; 或use vars qw( $foo ); 之外。

这非常神奇和混乱。使用访问器很容易避免这种情况。简单替换

$s->helper(
   do_this => sub {
      my $self = shift;
      $foo = shift;
   },
);

与

$s->helper(
   do_this => sub {
      my $self = shift;
      $self->foo(shift);
   },
);

如果还需要添加访问器，可以使用如下：

$s->helper(
   foo => sub {
      shift;
      state $foo;
      $foo = shift if @_;
      $foo
   },
   do_this => sub {
      my $self = shift;
      $self->foo(shift);
   },
);

顺便说一句，Mojo::Util 中的monkey_patch 可以用作helper 的替代品。（感谢@brian d foy 提出。）它做同样的事情，但它有两个额外的好处：

你不需要支持它。
它设置匿名子的名称，以便堆栈跟踪使用有意义的名称而不是__ANON__。

切换到monkey_patch 并不能解决您的问题，但除了我上面提到的方法更改之外，我确实建议使用它（或类似方法）。

use Mojo::Util qw(  );
sub helper { shift; Mojo::Util::monkey_patch(__PACKAGE__, @_); }

【讨论】：

我没有说它可以替代helper，只是说它可能是相关的。由于我的答案没有深入，并且在重新阅读问题后我仍然不明白问题所在，我只是删除了我的低质量答案。通常，如果我看到 @ikegami 看到了一个问题但没有回答它，我会尝试留下一些东西，以免人们认为我们忽略了它们。
@brian d foy，关于“我没有说它可以替代 helper”，抱歉，我只是想表扬一下。我已经改写了有问题的文字。
@brian d foy, Re "我还是不明白这个问题，"，sub { my $self = shift; $foo = shift; } 应该“神奇地”变成sub { my $self = shift; ${(ref $self) . '::foo'} = shift; }，也就是说@ 987654338@ 应该在安装方法的包中查找$foo，而不是在编译代码的包中。
这不是问题。这就是这个人试图解决一些未说明的问题的方式。
@brian d foy，当然。使用访问器很可能解决这个问题，不管它是什么。

【解决方案2】：

考虑roles。

# role module
package SomeThing::Role::Foo;
use Role::Tiny;
sub foo { 42 }
1;

# user
use strict;
use warnings;
use SomeThing;
use With::Roles;

my $something_with_foo = SomeThing->with::roles('+Foo');
# new subclass of SomeThing, doesn't affect other usage of SomeThing
my $obj = $something_with_foo->new;

# can also dynamically apply to an existing object
my $obj = SomeThing->new->with::roles('+Foo');
print $obj->foo;

【讨论】：