驼鹿胁迫和建设者

Question

这是继我的previous question 关于 Moose 结构化类型之后的内容。我为问题的长度道歉。我想确保我包含了所有必要的细节。

MyApp::Type::Field 定义了一个结构化类型。我使用强制来允许从我的 Person 类中更轻松地设置其 value 属性（请参见下面的示例）。请注意，在我的实际应用程序中，Field 类型不仅仅用于人名，我还从 HashRef 中强制转换。

我还需要在构建时从MyApp::Person 设置MyApp::Type::Field size 和required 只读属性。我可以使用 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，使类的接口非常干净：

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 设置一组参数。所以定义一个 PersonName 类型作为 Field 的子类型。您的强制将是从字符串到 PersonName。然后强制代码，并可以在调用Field->new() 时将适当的值应用于 required 和 length。

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

有关此方法的更多信息，请参阅Moose Cookbook Meta Recipes。