我可以在包中注入 perl sub 吗?

Can I inject a perl sub in a package?

我希望能够在 class 中动态地 "inject" 方法,类似于 Mojolicious 助手的情况。像这样:

my $s = SomeThing->new;

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

$s->do_this('bar');

我已经做了一些距离,但我希望被注入的 subs 在它们被注入的 class 的命名空间中运行,而不是在 main 中运行。换句话说,目前的工作方式如下:

$s->do_this('bar');

print 'in main:      ', $foo;             

this 打印 "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
        }
    }
};

有办法吗?我怀疑我会把严格性搞得一团糟——但我现在还不想放弃(这是一个很好的学习技巧)。

您要求更改与已编译的 anon sub 关联的包,以便进行变量查找。不知道可不可以。

即使有可能,您也不想这样做,因为您的代码仍然无法正常工作。您必须将 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);
   },
);

如果你还需要添加accessor,可以使用如下:

$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 的提出。)它做同样的事情,但它有两个额外的好处:

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

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

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

考虑 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;