Moose-принуждение и строители

Question

Это относится к моим previous question о структурированных типах Moose. Прошу прощения за вопрос. Я хотел, чтобы я включил все необходимые детали.

MyApp::Type::Field определяет структурированный тип. Я использую принуждение, чтобы его атрибут value был легче установлен из моего класса Person (см. Пример ниже). Обратите внимание, что в моем реальном приложении, где тип поля используется не только для имени человека, я также принуждаю вас к HashRef.

Мне также необходимо установить MyApp::Type::Fieldsize и 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. Добавление писатель дает обеспечивает эквивалентный сеттер, что делает интерфейс к классу довольно чистому:

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

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

См. Moose Cookbook Meta Recipes для получения дополнительной информации об этом подходе.