Perl Moose Dynamic 将值分配给属性建议

Question

我正在努力完成以下任务。

我有一个 Moose 风格的模块 A 和 B
需要元数据作为强制参数
B想多次创建A的对象
因此想设置为属性

有没有更好的方法来做到这一点（这样我就可以将元数据传递给包 A 并在包 B 中避免多次调用 new），如果可能的话也尝试完成 1 行。

package A {

    use Moose;
    has 'metadata' => (
        is      => 'rw',
        isa     => 'HashRef',
        default => sub {{}},
        required => 1
    );

    sub process {
        die unless keys %{shift->metadata};
        # ... process
        print "Success!\n";
    }

    __PACKAGE__->meta->make_immutable;

}
#######B#########
package B {
    use Moose;
    use A;

    has 'obj_a' => (
        is      => 'rw',
        isa     => 'A',
        writer  => 'set_meta',
    );

    sub _set_meta {
        my ( $self, $metadata) = @_;
        return $self->set_meta(A->new(metadata => $metadata));
    }

    sub obj_with_meta {
        my ( $self, $metadata) = @_;
        return A->new(metadata => $metadata);
    }

    __PACKAGE__->meta->make_immutable;

    1;
}

############
use B;
my $b = B->new();

# want to call like this but I am sure I am missing something which moose is providing
# here I am supposed to call obj_a instead of _set_meta I believe
#calling _set_meta I am bypassing the Moose attribute I guess
$b->_set_meta({id=>'id for metadata'})->process;

#works
$b->obj_with_meta({id=>'id for metadata'})->process;

注意上面的代码是有效的输出是成功！成功！

我想知道驼鹿身上是否有我可以利用的东西。这样我就可以通过写入元数据或使用某些特征来将数据共享到下一个class。

包A是催化剂控制器包 B 是一个独立的模块，与催化剂没有紧密耦合。

Answer 1

在 Catalyst 应用程序中将业务逻辑与控制器分开是个好主意。您可以将其封装到自己的模块中，并通过薄层 Catalyst::Model 使用它们。

您实际上不需要担心从控制器传递会话，因为所有 Catalyst::Components 都为您提供了一种方法，称为 ACCEPT_CONTEXT。这是一种可以在任何组件中实现的方法，但通常用于模型中。每当 $c->model(...) 调用完成时都会调用它，它会传递上下文对象 $c，并且应该 return 一个可以像模型一样使用的对象。这可能是也可能不是 Catalyst::Component 对象。

我已经构建了一个示例应用程序，我将使用它来回答这个问题。你可以找到 the full source code in this github repository.

假设有一个名为 MyApp::Model::API::User 的 Catalyst::Model class，代码如下。它继承自 Catalyst::Model::DBI，以便通过 Catalyst 利用数据库句柄缓存。

package MyApp::Model::API::User;

use strict;
use warnings;

use API::User;

use parent 'Catalyst::Model::DBI';

sub ACCEPT_CONTEXT {
    my ( $self, $c, @args ) = @_;

    $c->log->debug( sprintf 'Creating a new API::User object for %s line %d',
        ( caller(2) )[ 0, 2 ] );

    return API::User->new(
        dbh      => $self->dbh,
        metadata => $c->session->{data},
    );
}

1;

每次控制器执行 $c->model('API::User') 时，都会调用 ACCEPT_CONTEXT 方法，并实例化一个名为 API::User 的 class，这是我对您的 [=71] 的实现=] 业务逻辑。它接受 DBI 模型为我们提供的数据库句柄对象，以及我们从用户会话中获取的元数据。

在我的示例中，我将用户 ID 作为会话的一部分，以便可以使用实际的元数据（如果有 none，我们创建一个，但这在这里并不重要）。

package API::User;

use Moose;
use DBI;

has metadata => (
    isa      => 'HashRef',
    is       => 'ro',
    required => 1,           # either it's required or it has a default
);

has dbh => (
    isa      => 'DBI::db',
    is       => 'ro',
    required => 1,
);

sub create { ... }

sub read {
    my ($self) = @_;

    my $sql = 'SELECT id, number_of_writes FROM user WHERE id=?';
    my $sth = $self->dbh->prepare($sql);

    $sth->execute( $self->metadata->{id} );

    return $sth->fetchrow_hashref;
}

sub write { ... }

__PACKAGE__->meta->make_immutable;

API::User有3个方法。它可以创建、读取和写入。作为示例，这一切都非常简化。我们将重点阅读此答案。请注意 metadata 属性是 required，但没有 default。你不能两者兼得，因为它们相互矛盾。你希望它被传入，所以你希望它在丢失时爆炸，而不是设置空哈希引用的默认值。

最后，在控制器中使用如下。

package MyApp::Controller::User;
use Moose;
use namespace::autoclean;

BEGIN { extends 'Catalyst::Controller' }

__PACKAGE__->config( namespace => 'user' );

sub auto : Private {
    my ( $self, $c ) = @_;

    unless ( $c->session->{data}->{id} ) {
        # we have to initialise data first because the model depends on it
        $c->session->{data} = {}; 
        $c->session->{data}->{id} = $c->model('API::User')->create;
    }
    return 1;
}

sub index_get : Path('') Args(0) GET {
    my ( $self, $c ) = @_;

    $c->stash->{json_data} = $c->model('API::User')->read;

    return;
}

sub index_post : Path('') Args(0) POST {
    my ( $self, $c ) = @_;

    $c->stash->{json_data} = $c->model('API::User')->write;

    return;
}

__PACKAGE__->meta->make_immutable;

我正在 auto 操作中设置一些会话数据，它在任何其他操作之前被调用。对于特定的会话，这将完成一次，然后该用户的 ID 将存储在会话中以供后续请求使用。

在 index_get 操作中，我通过 $c->model('API::User) 访问我们的 class)，这将在我们的模型 class 上调用 ACCEPT_CONTEXT，实例化一个新的API::User 填充了现有数据库句柄以及包含我们用户 ID 的会话元数据的对象。

为了这个例子，我使用了一个 JSON 视图，这样我们就可以看到数据库中发生了什么。

当我们 curl 应用程序以获取我们的用户时，日志如下所示。

[info] *** Request 2 (0.044/s) [31642] [Fri May  6 19:01:25 2022] ***
[debug] Path is "user"
[debug] "GET" request for "user" from "127.0.0.1"
[debug] Created session "36d509c55d60c02a7a0a9cbddfae9e50b092865a"
[debug] Creating a new API::User object for MyApp::Controller::User line 15
[debug] Creating a new API::User object for MyApp::Controller::User line 23
[debug] Response Code: 200; Content-Type: application/json; charset=utf-8; Content-Length: unknown
[info] Request took 0.018616s (53.717/s)
.------------------------------------------------------------+-----------.
| Action                                                     | Time      |
+------------------------------------------------------------+-----------+
| /user/auto                                                 | 0.013309s |
| /user/index_get                                            | 0.000640s |
| /end                                                       | 0.000994s |
|  -> MyApp::View::JSON->process                             | 0.000411s |
'------------------------------------------------------------+-----------'

如您所见，我们先去auto，然后去index_get。在上面的调试语句中，它创建了 API::User 的两个实例。一个是在 auto 中创建一个新用户，因为我没有提供会话 cookie，第二个是来自 index_get.

如果我们通过提供会话 cookie 与现有用户一起调用它（请参阅存储库中的测试脚本），它只会调用一次。

[info] *** Request 8 (0.037/s) [31642] [Fri May  6 19:04:16 2022] ***
[debug] Path is "user"
[debug] "GET" request for "user" from "127.0.0.1"
[debug] Found sessionid "710cb37124a7042b89f1ffa650985956949df7d0" in cookie
[debug] Restored session "710cb37124a7042b89f1ffa650985956949df7d0"
[debug] Creating a new API::User object for MyApp::Controller::User line 23
[debug] Response Code: 200; Content-Type: application/json; charset=utf-8; Content-Length: unknown
[info] Request took 0.017655s (56.641/s)
.------------------------------------------------------------+-----------.
| Action                                                     | Time      |
+------------------------------------------------------------+-----------+
| /user/auto                                                 | 0.001887s |
| /user/index_get                                            | 0.001238s |
| /end                                                       | 0.003510s |
|  -> MyApp::View::JSON->process                             | 0.001463s |
'------------------------------------------------------------+-----------'

Answer 2

感谢@simbabque 我创建了一个这样的工厂方法

package MyApp::Model::API::Factory;

use Moose::Util;
use Module::Load  qw/autoload/;

sub ACCEPT_CONTEXT {
    my ( $self, $c, $args ) = @_;

    my $module = 'MyApp::API::';

    if(!defined $args->{api_module}) {
        #eg. MyApp::Controller::API::Event::ConferenceCall::Role
        my $caller_package = ( caller(2) )[ 0 ];

        if($caller_package->can('api_module')) {
            #get from attributes
            $module .= $caller_package->new->api_module;
        } else {
            #auto detect/infer from caller name
            $caller_package =~ /MyApp::Controller::API::(.*)/;
            $module .= ;
        }

    } else {
        #append the prefix to the module name MyApp::API::
        $module .= $args->{api_module};
    }

    $c->log->debug( sprintf "Creating a new %s object for %s line %d",$module,( caller(2) )[ 0, 2 ] );

    my $object;

    try {
        autoload  $module;
        my $meta_method;
        #auto_detect meta_method if not defined
        # here check the attributes of the class and see if it has a meta_method with suffix _metadata
        # if it does, use that
        if(!exists $args->{meta_method}) {
            my $meta = Moose::Util::find_meta($module);
            my @has    = $meta->get_attribute_list;
            foreach my $has (@has) {
                #since we have standard suffixes for the meta_methods _metadata
                if($has =~ /_metadata$/ ) {
                    $meta_method = $has;
                    last;
                }
            }
        } else {
            $meta_method = $args->{meta_method};
        }
        $object = $module->new( $meta_method => $c->{stash}{internal});
        $c->log->debug("object created by api factory for ". ref($object) . " meta attr set: $meta_method");
    } catch {
        $c->log->error( $_ );
        return;
    };

    return $object;
}

1;

在每个控制器中

    my $user_api_obj = $c->model('API::Factory');

    my $result = $user_api_obj->register_user($valid_params);

Perl Moose Dynamic 将值分配给属性建议

Perl Moose Dynamic assign the value to attribute suggestion

perl

moose

moosex-types