perl - 驼鹿胁迫和 build 者

Question

这是我的previous question关于 Moose 结构化类型。我为问题的长度道歉。我想确保我包含了所有必要的细节。
MyApp::Type::Field定义结构化类型。我使用强制来允许它的value从我的Person 中更容易设置属性类(参见下面的示例)。请注意，在我的实际应用程序中，Field 类型不仅仅用于人名，我还从 HashRef 中强制转换。

我还需要设置 MyApp::Type::Field size和 required来自 MyApp::Person 的只读属性在构建时。我可以使用 builder 方法来做到这一点，但如果使用强制，则不会调用它，因为我的强制直接创建一个新对象，而不使用 builder 方法。

我可以通过添加 around 来解决这个问题方法修饰符为 MyApp::Person (见下面的例子)，但这感觉很乱。 around方法修饰符被频繁调用，但我只需要设置一次只读属性。

有没有更好的方法来做到这一点，同时仍然允许强制？ MyApp::Type::Field类无法初始化 size和 required通过默认值或构建器，因为它无法知道值应该是什么。

可能只是因为我放弃了强制，转而支持没有 around。修饰符。

MyApp::Type::Field

coerce 'MyApp::Type::Field'
    => from 'Str'
        => via { MyApp::Type::Field->new( value => $_ ) };

has 'value'    => ( is => 'rw' );
has 'size'     => ( is => 'ro', isa => 'Int',  writer => '_set_size',     predicate => 'has_size' );
has 'required' => ( is => 'ro', isa => 'Bool', writer => '_set_required', predicate => 'has_required' );

MyApp::Person

has name => ( is => 'rw', isa => 'MyApp::Type::Field', lazy => 1, builder => '_build_name', coerce  => 1 );       

sub _build_name {
    print "Building name\n";
    return MyApp::Type::Field->new( size => 255, required => 1 );
}

MyApp::Test

print "Create new person with coercion\n";
my $person = MyApp::Person->new();
print "Set name\n";
$person->name( 'Joe Bloggs' );
print "Name set\n";
printf ( "Name: %s [%d][%d]\n\n", $person->name->value, $person->name->size, $person->name->required );

print "Create new person without coercion\n";
$person = MyApp::Person->new();
print "Set name\n";
$person->name->value( 'Joe Bloggs' );
print "Name set\n";
printf ( "Name: %s [%d][%d]\n\n", $person->name->value, $person->name->size, $person->name->required );

打印:

Create new person with coercion
Set name
Name set
Name: Joe Bloggs [0][0]

Create new person without coercion
Set name
Building name
Name set
Name: Joe Bloggs [255][2]

添加 around方法修饰符为 MyApp::Person , 并更改构建器使其不设置 size和 required :

around 'name' => sub {
    my $orig = shift;
    my $self = shift;

    print "Around name\n";

    unless ( $self->$orig->has_size ) {
        print "Setting size\n";
        $self->$orig->_set_size( 255 );
    };

    unless ( $self->$orig->has_required ) {
        print "Setting required\n";
        $self->$orig->_set_required( 1 );
    };

    $self->$orig( @_ );
};

sub _build_name {
    print "Building name\n";
    return MyApp::Type::Field->new();
}

当 MyApp::Test正在运行， size和 required设置两次。

Create new person with coercion
Set name
Around name
Building name
Setting size
Setting required
Name set
Around name
Setting size
Setting required
Around name
Around name
Name: Joe Bloggs [255][3]

Create new person without coercion
Set name
Around name
Building name
Name set
Around name
Around name
Around name
Name: Joe Bloggs [255][4]

建议的解决方案

daotoad's为每个 MyApp::Person 创建子类型的建议属性，并从 Str 强制该子类型变成 MyApp::Type::Field效果很好。我什至可以通过将整个批处理包装在一个 for 循环中来创建多个子类型、强制和属性。这对于创建具有相似属性的多个属性非常有用。

在下面的示例中，我使用 handles 设置了委派。 ，所以 $person->get_first_name被翻译成 $person->first_name->value .添加一个 writer 提供了一个等效的 setter，使类的接口(interface)非常干净:

package MyApp::Type::Field;

use Moose;

has 'value'     => (
    is          => 'rw',
);

has 'size'      => (
    is          => 'ro',
    isa         => 'Int',
    writer      => '_set_size',
);

has 'required'  => (
    is          => 'ro',
    isa         => 'Bool',
    writer      => '_set_required',
);

__PACKAGE__->meta->make_immutable;
1;

package MyApp::Person;
use Moose;
use Moose::Util::TypeConstraints;
use namespace::autoclean;

{
    my $attrs = {
        title      => { size =>  5, required => 0 },
        first_name => { size => 45, required => 1 },
        last_name  => { size => 45, required => 1 },
    };

    foreach my $attr ( keys %{$attrs} ) {

        my $subtype = 'MyApp::Person::' . ucfirst $attr;

        subtype $subtype => as 'MyApp::Type::Field';

        coerce $subtype
           => from 'Str'
               => via { MyApp::Type::Field->new(
                   value    => $_,
                   size     => $attrs->{$attr}{'size'},
                   required => $attrs->{$attr}{'required'},
               ) };

        has $attr   => (
            is      => 'rw',
            isa     => $subtype,
            coerce  => 1,
            writer  => "set_$attr",
            handles => { "get_$attr" => 'value' },
            default => sub {
                MyApp::Type::Field->new(
                    size     => $attrs->{$attr}{'size'},
                    required => $attrs->{$attr}{'required'},
                )
            },
        );
    }
}

__PACKAGE__->meta->make_immutable;
1;

package MyApp::Test;

sub print_person {
    my $person = shift;

    printf "Title:      %s [%d][%d]\n" .
           "First name: %s [%d][%d]\n" .
           "Last name:  %s [%d][%d]\n",
           $person->title->value || '[undef]',
           $person->title->size,
           $person->title->required,
           $person->get_first_name || '[undef]',
           $person->first_name->size,
           $person->first_name->required,
           $person->get_last_name || '[undef]',
           $person->last_name->size,
           $person->last_name->required;
}

my $person;

$person = MyApp::Person->new(
    title      => 'Mr',
    first_name => 'Joe',
    last_name  => 'Bloggs',
);

print_person( $person );

$person = MyApp::Person->new();
$person->set_first_name( 'Joe' );
$person->set_last_name( 'Bloggs' );

print_person( $person );

1;

打印:

Title:      Mr [5][0]
First name: Joe [45][6]
Last name:  Bloggs [45][7]
Title:      [undef] [5][0]
First name: Joe [45][8]
Last name:  Bloggs [45][9]

Answer 1

每个人对 name 的要求是否不同？ field ？这似乎不太可能。

您似乎更有可能为每个 Field 设置一组参数。整个应用程序。所以定义一个 PersonName 类型作为 Field 的子类型。您的强制将是从字符串到 PersonName。然后强制代码可以在调用 Field->new() 时将适当的值应用于 required 和 length .

此外，这看起来真的像是在为 Moose 对象构建一个属性对象，该对象基于已经提供属性对象的元对象系统。为什么不扩展您的属性对象而不是自己创建？

见Moose Cookbook Meta Recipes有关此方法的更多信息。