Perl MooseX::Method::Signatures 将自定义代码注入所有方法

Question

我正在尝试在应用程序中使用MooseX::Method::Signatures 和MooseX::Declare，我需要在编译时而不是运行时在每个方法的开头注入自定义代码：

而不是这个：

use MooseX::Declare;

method check ($value) {
     $return $value;
}

我想在编译时在每个方法的开头注入一段代码，就像这样：

method check ($value) {
     my ($value) = $self->validate($value);
     $return $value;
}

现在我想要代码

我的 ($value) = $self->validate($value);

在编译时而不是在运行时使用 MooseX::Decalre 模块在包中所有方法的开头自动注入，我的意思是在之前、之后、周围等不使用 Moose 方法修饰符。

这需要修改这些模块，但我需要有人告诉我从哪里开始。

我能够修改模块Method::Signatures::Simple 以准确地做到这一点，并通过电子邮件向作者发送了修改但没有得到回复。即使进行修改我也无法使用它的原因是它不支持类型检查和 MooseX::Declare 等默认值。

以下模块Method::Signatures::Simple的修改版本供参考，我使用如下：

使用 Method::Signatures::Simple (method => 'method,action', function => 'function', invocant=>'$this', 'inject'=>'my ($me) = $this->me;');

现在在所有方法中，我都注入了代码my ($me) = $this->me;，我可以这样使用它：

method check ($value) {
     say $me 
}

这里是修改后的 Method::Signatures::Simple 模块。

package Method::Signatures::Simple;
{
  $Method::Signatures::Simple::VERSION = '1.07';
}

use warnings;
use strict;

=head1 NAME

Method::Signatures::Simple - Basic method declarations with signatures, without source filters

=head1 VERSION

version 1.07

=cut

use base 'Devel::Declare::MethodInstaller::Simple';

our $inject_code;

sub import {
    my $class = shift;
    my %opts  = @_;
    $opts{into} ||= caller;

    my $meth = delete $opts{name} || delete $opts{method};
    my $func = delete $opts{function};
    my $invocant = delete $opts{invocant} || '$self';
    $inject_code = delete $opts{inject};

    $inject_code .= ";" if ($inject_code && $inject_code !~ /\;$/);

    # if no options are provided at all, then we supply defaults
    unless (defined $meth || defined $func) {
        $meth = 'method';
        $func = 'func';
    }

    my @meth = split /\s*\,+\s*/, $meth;

    # we only install keywords that are requested
    foreach $meth (@meth) {
        if (defined $meth) {
            $class->install_methodhandler(
            name     => $meth,
            invocant => $invocant,
            %opts,
            );
        }
    }

    if (defined $func) {
        $class->install_methodhandler(
          name     => $func,
          %opts,
          invocant => undef,
        );
    }
}

sub strip_proto {
    my $self = shift;
    my ($proto) = $self->SUPER::strip_proto()
      or return '';
    # we strip comments and newlines here, and stash the number of newlines.
    # we will re-inject the newlines in strip_attrs(), because DD does not
    # like it when you inject them into the following code block. it does not
    # object to tacking on newlines to the code attribute spec though.
    # (see the call to inject_if_block() in DD::MethodInstaller::Simple->parser)
    $proto =~ s/\s*#.*$//mg;
    $self->{__nls} = $proto =~ s/[\r\n]//g;
    $proto;
}

sub strip_attrs {
    my $self = shift;
    my ($attrs) = $self->SUPER::strip_attrs();
    $attrs ||= '';
    $attrs .= $/ x $self->{__nls} if $self->{__nls};
    $attrs;
}

sub parse_proto {
    my $self = shift;
    my ($proto) = @_;
    $proto ||= '';
    $proto =~ s/\s*#.*$//mg;
    $proto =~ s/^\s+//mg;
    $proto =~ s/\s+$//mg;
    $proto =~ s/[\r\n]//g;
    my $invocant = $self->{invocant};

    $invocant = $1 if $proto =~ s{(\$\w+)\s*:\s*}{};

    my $inject = '';
    $inject .= "my ${invocant} = shift;" if $invocant;
    $inject .= "my ($proto) = \@_;"      if defined $proto and length $proto;
    $inject .= "$inject_code" if $inject_code;
    $inject .= '();'; # fix for empty method body

    return $inject;
}

Answer 1

Moops 和 Kavorka 提供了几乎与 MooseX::Declare 和 MooseX::Method::Signatures 兼容的语法，并且被设计为通过特征非常可扩展（甚至从内部！）。我会提请您注意以下section of documentation for MooseX::Declare：

警告： MooseX::Declare 是基于 Devel::Declare 的，这是一个由 mst 最初实现的巨大破解包，其目的是因为它的存在让 perl 核心开发人员非常不安，以至于他们在核心中实现了正确的关键字处理。

[...]

如果您想在新代码中使用声明式语法，请看在小猫的份上，为自己准备一个最新的 perl，然后改用 Moops。

MooseX::Declare 本身不是很容易扩展。我知道。 I've tried.

记住所有这些，而且因为我写了 Moops，我将使用它作为示例。在这里，我们定义了一个角色Kavorka::TraitFor::Sub::ProvidesMe，它将向方法中注入一点代码。然后，我们将该角色应用于使用 does ProvideMe 的方法。

package main;
use Moops;

role Kavorka::TraitFor::Sub::ProvideMe
{
    around inject_prelude (@_)
    {
        my $prelude = $self->$next(@_);
        $prelude .= 'my ($me) = $self->me;();';
        return $prelude;
    }
}

class MyClass
{
    method me () { "tobyink" }

    method example () does ProvideMe
    {
        # This gets injected: my ($me) = $self->me;
        return $me;
    }
}

my $obj = MyClass->new;
say $obj->example;  ## says "tobyink"