これは、Moose構造化タイプに関する以前の質問に続くものです。質問が長かったことをお詫び申し上げます。必要なすべての詳細が含まれていることを確認したかったのです。
MyApp::Type::Field構造化タイプを定義します。私は強制を使用して、そのvalue属性をクラスからより簡単に設定できるようにしますPerson(以下の例を参照)。Fieldタイプが人の名前だけでなく使用される実際のアプリケーションでは、HashRefからも強制変換することに注意してください。
また、ビルド時にMyApp::Type::Field sizeからrequired読み取り専用属性を設定する必要があります。MyApp::Personこれはビルダーメソッドを使用して実行できますが、強制が使用されている場合は呼び出されません。これは、強制がビルダーメソッドを使用せずに新しいオブジェクトを直接作成するためです。
aroundメソッド修飾子をに追加することでこれを回避できますがMyApp::Person(以下の例を参照)、これは厄介な感じがします。aroundメソッド修飾子は頻繁に呼び出されますが、読み取り専用属性を設定する必要があるのは1回だけです。
強制を許可しながら、これを行うためのより良い方法はありますか?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と、 required2回設定されます。
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各属性のサブタイプを作成し、そのサブタイプをaから作業に強制Strするというdaotoadの提案は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]