perl - 扩展 MooseX::Declare 时注入(inject)代码中的语法错误

Question

这是一个大问题，所以请多多包涵。最后有一 jar 金子。

主要出于实验原因，我正在尝试制作 MooseX::Declare 的自定义扩展，它可以做一些对特定爱好项目有用的额外魔法。例如，我想制作 class关键字注入(inject)一些额外的东西，比如从 List::Util 等导入有用的实用程序，打开各种额外的 pragma(除了 strict 和 warnings )，自动导入我的全局 Config 对象等等。

所以我写了下面的测试并开始看看我是否可以让它工作。令人惊讶的是，我能够到达那里的 99%，但现在我遇到了一个我无法弄清楚的问题。我的定制class关键字在注入(inject)的代码中因语法错误而死。

#!/usr/bin/env perl

use MyApp::Setup;

class Foo { 
    use Test::More tests => 1;

    has beer => ( is => 'ro', default => 'delicious' );
    method something { 
        is $self->beer, 'delicious';
    }
}


Foo->new->something;

MyApp::Setup如下所示。将来它会做更多的事情，但现在它只是调用 import在我的 MX::D 子类上:

package MyApp::Setup;

use strict;
use warnings;

use MyApp::MooseX::Declare;

sub import { 
    goto &MyApp::MooseX::Declare::import;
}

1;

那个类看起来像这样:

package MyApp::MooseX::Declare;

use Moose;

use MyApp::MooseX::Declare::Syntax::Keyword::Class;
use MyApp::MooseX::Declare::Syntax::Keyword::Role;
use MyApp::MooseX::Declare::Syntax::Keyword::Namespace;

extends 'MooseX::Declare';

sub import {
    my ($class, %args) = @_;

    my $caller = caller;

    for my $keyword ( __PACKAGE__->keywords ) {
        warn sprintf 'setting up keyword %s', $keyword->identifier;
        $keyword->setup_for($caller, %args, provided_by => __PACKAGE__ );
    }
}

sub keywords { 
    # override the 'class' keyword with our own
    return
      ( MyApp::MooseX::Declare::Syntax::Keyword::Class->new( identifier => 'class' ),
        MyApp::MooseX::Declare::Syntax::Keyword::Role->new( identifier => 'role' ),
        MyApp::MooseX::Declare::Syntax::Keyword::Namespace->new( identifier => 'namespace' ) );
}

1;

我设置了三个关键字类，只包含一个替换 MX::D::Syntax::NamespaceHandling 的额外角色。 .

package MyApp::MooseX::Declare::Syntax::Keyword::Class;

use Moose;

extends 'MooseX::Declare::Syntax::Keyword::Class';
with 'MyApp::MooseX::Declare::Syntax::NamespaceHandling';

1;

(其他两个是相同的。)

在真正的 MX::D 中，NamespaceHandling 内容被组合成一个名为 MooseSetup 的单独角色，该角色本身被组合成关键字类。在一个地方做这一切似乎很有效。不过，我不知道结构上的轻微偏差是否是我问题的根源。有一次，我有自己的 MooseSetup 版本，但这导致了我无法弄清楚的构图冲突。

最后，肉和土 bean 是我的 NamespaceHandling 版本，它覆盖了 parse方法。它的大部分只是从原件复制和粘贴。

package MyApp::MooseX::Declare::Syntax::NamespaceHandling;

use Moose::Role;
use Carp 'croak';
use Moose::Util 'does_role';
use MooseX::Declare::Util 'outer_stack_peek';


with 'MooseX::Declare::Syntax::NamespaceHandling';

# this is where the meat is!

sub parse {
    my ($self, $ctx) = @_;

    # keyword comes first
    $ctx->skip_declarator;

    # read the name and unwrap the options
    $self->parse_specification($ctx);

    my $name = $ctx->namespace;

    my ($package, $anon);

    # we have a name in the declaration, which will be used as package name
    if (defined $name) {
        $package = $name;

        # there is an outer namespace stack item, meaning we namespace below
        # it, if the name starts with ::
        if (my $outer = outer_stack_peek $ctx->caller_file) {
            $package = $outer . $package
                if $name =~ /^::/;
        }
    }

    # no name, no options, no block. Probably { class => 'foo' }
    elsif (not(keys %{ $ctx->options }) and $ctx->peek_next_char ne '{') {
        return;
    }

    # we have options and/or a block, but not name
    else {
        $anon = $self->make_anon_metaclass
            or croak sprintf 'Unable to create an anonymized %s namespace', $self->identifier;
        $package = $anon->name;
    }

    warn "setting up package [$package]";

    # namespace and mx:d initialisations
    $ctx->add_preamble_code_parts(
        "package ${package}",
        sprintf(
            "use %s %s => '%s', file => __FILE__, stack => [ %s ]",
            $ctx->provided_by,
            outer_package => $package,
            $self->generate_inline_stack($ctx),
       ),
    );

    # handle imports and setup here (TODO)


    # allow consumer to provide specialisations
    $self->add_namespace_customizations($ctx, $package);

    # make options a separate step
    $self->add_optional_customizations($ctx, $package);

    # finish off preamble with a namespace cleanup
    # we'll use namespace::sweep instead

    #$ctx->add_preamble_code_parts(
    #    $ctx->options->{is}->{dirty}
    #        ? 'use namespace::clean -except => [qw( meta )]'
    #        : 'use namespace::autoclean'
    #);

    # clean up our stack afterwards, if there was a name
    $ctx->add_cleanup_code_parts(
        ['BEGIN',
            'MooseX::Declare::Util::outer_stack_pop __FILE__',
        ],
    );

    # actual code injection
    $ctx->inject_code_parts(
        missing_block_handler => sub { $self->handle_missing_block(@_) },
    );

    # a last chance to change things
    $self->handle_post_parsing($ctx, $package, defined($name) ? $name : $anon);
}


1;

当我运行测试时，一切似乎都很好——我收到警告消息，表明正在调用正确的方法并且正在设置包“Foo”。然后它死于:

syntax error at t/default.t line 5, near "{package Foo"

所以似乎有些东西在 package 之前或之后注入(inject)了一些代码导致语法错误的声明，但我不知道是什么。我尝试过随机玩 parse 中的各种项目。 sub (我实际上不知道他们现在都在做什么)但我似乎无法消除甚至改变错误。当然，(据我所知)没有办法实际检查生成的代码，这可能会产生线索。

谢谢你的帮助。



一些更新:在 MooseX::Declare::Context 内部查看后，我添加了一些 print通过调用 inject_code_parts 来准确查看注入(inject)的内容.这是生成(整理)的实际代码:

 package Foo; 

 use MyApp::MooseX::Declare outer_package => 'Foo', file => __FILE__, stack => [ 
     MooseX::Declare::StackItem->new(q(identifier), q(class), q(handler), 
     q(MyApp::MooseX::Declare::Syntax::Keyword::Class), q(is_dirty), q(0), 
     q(is_parameterized), q(0), q(namespace), q(Foo)) ];; 

 BEGIN { Devel::Declare::Context::Simple->inject_scope('BEGIN { 
   MooseX::Declare::Util::outer_stack_pop __FILE__ }') }; ;

我不能说我知道所有这些是做什么的(尤其是 outer_stack_pop 的东西)，但在我看来，这一切在语法上都还可以。我仍然认为在这一切之前注入(inject)代码会导致语法错误。

Answer 1

好吧，那是一个 hell 般的调试 session ，但我终于找到了问题并解决了问题。破解后打开两个MooseX::Declare::Context和 Devel::Declare::Context::Simple (前任代表)我能够跟踪流程并通过大量转储到 STDOUT，我意识到 MooseSetup.pm 中的一些额外处理程序，我认为我已正确组合到我的关键字类中，实际上并不存在。因此，注入(inject)的结果代码没有附加适当的阴影/清理内容。

无论如何，我现在有一个看起来完全可以工作的定制 MooseX::Declare!我真的很兴奋——这意味着我可以打字

use MyApp::Setup; 

class MyApp::Foo { ... }

还有那个 class语句设置了一大堆特定于应用程序的样板。拉德。