Принуждение лосей и строители

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]

Предложенное решение

даожаба предложение создать подтип для каждого 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.Затем код приведения может применить соответствующие значения к требуемому и длине при вызове. Field->new().

Кроме того, на самом деле это похоже на то, что вы создаете объект атрибута для объекта Moose, который основан на системе метаобъектов, которая уже предоставляет объекты атрибутов.Почему бы не расширить свой объект атрибута, а не создавать свой собственный?

См. Мета-рецепты кулинарной книги лося для получения дополнительной информации об этом подходе.