驼鹿胁迫和建设者

Question

这是我之前关于Moose结构类型的问题的结果.我为这个问题的长度道歉.我想确保包含所有必要的细节.

MyApp::Type::Field定义结构化类型.我使用强制来允许value从我的Person类中更容易地设置其属性(参见下面的示例).请注意,在我的实际应用程序中,Field类型不仅仅用于一个人的名字,我还强制使用HashRef.

我还需要在构建时设置MyApp::Type::Field size和required只读属性MyApp::Person.我可以使用构建器方法执行此操作,但如果使用强制,则不会调用此方法,因为我的强制直接创建了一个新对象,而不使用构建器方法.

我可以通过添加一个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的创建每个亚型的建议MyApp::Person属性,并强迫从该亚型Str为MyApp::Type::Field工作得很好.我甚至可以通过在包裹一大堆for循环创建多个亚型,强制转换和属性.这对于创建具有类似属性的多个属性非常有用.

在下面的示例中,我已使用设置委托handles,因此将$person->get_first_name其转换为$person->first_name->value.添加一个作家给人提供了一个相当的二传手,使得接口的类挺干净的:

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。然后强制代码可以在调用时将适当的值应用于 required 和 length Field->new()。

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

有关此方法的更多信息，请参阅《驼鹿食谱元食谱》 。