5

这是我之前关于 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，并更改构建器以使其不设置sizeand 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属性创建一个子类型，并将该子类型从 a 强制Str转换为 aMyApp::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]
4

1 回答 1

3

每个人都会对这个name领域有不同的要求吗？这似乎不太可能。

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

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

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

于 2010-12-13T16:05:03.730 回答