Это следует из моего предыдущего вопроса о структурированных типах Moose. Я прошу прощения за длину вопроса. Я хотел убедиться, что я включил все необходимые детали.
MyApp::Type::Field определяет структурированный тип. Я использую приведение, чтобы его атрибут value можно было легко установить из моего класса Person (см. Пример ниже). Обратите внимание, что в моем реальном приложении, где тип поля используется не только для имени человека, я также использую 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. Добавление объекта Writer обеспечивает эквивалентный метод установки, что делает интерфейс класса достаточно чистым:
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]