Question

这是我previous 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'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。

驼鹿胁迫和建设者

1 个答案: