我在以下子类型和强制链中缺少什么？我希望能够强制验证类型的arrayref或死于以下输入：
假设所有类型都是完全命名空间，并且未声明的函数validate和coerce_str分别验证（返回bool）并强制并从输入返回有效字符串。
subtype 'CustomType'
=> as 'Str'
=> where { validate($_) }
;
coerce 'CustomType'
=> from 'Str'
=> via { if (my $coerced = coerce_str($_)) {
return $coerced;
}
return $_;
}
;
subtype 'ArrayRefofCustomTypes'
=> as 'ArrayRef[CustomType]'
;
coerce 'ArrayRefofCustomTypes'
=> from 'CustomType'
=> via { [ $_ ] }
;
has 'values' => ( is => 'ro', required => 1,
isa => 'ArrayRefofCustomTypes',
coerce => 1,
);
我知道CustomType有效;因为我可以定义一个属性，并使用强制字符串或已经有效的字符串初始化对象。我不确定该怎么做的是显式地处理从构造函数中传递到传递的arrayref并单独验证所有包含的字符串。我已经阅读了关于深度胁迫（http://search.cpan.org/dist/Moose/lib/Moose/Manual/Types.pod#Deep_coercion）的文档几次，我只是不太明白，我希望有人可以指出我正确的方向。谢谢！
在这里，我将其简化为更简洁，但是：
{
package My::Class;
use strict;
use warnings;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'CustomType'
=> as 'Str'
=> where { validate($_) }
;
coerce 'CustomType'
=> from 'Str'
=> via { if (my $coerced = coerce_str($_)) {
return $coerced;
}
return $_;
}
;
subtype 'ArrayRefofCustomTypes'
=> as 'ArrayRef[CustomType]'
;
coerce 'ArrayRefofCustomTypes'
=> from 'CustomType'
=> via { [ $_ ] }
;
has 'values' => ( is => 'ro', required => 1,
isa => 'ArrayRefofCustomTypes',
coerce => 1,
);
sub validate {
my $val = shift;
if ($val =~ /^\w+$/) {
return 1;
}
return ();
}
sub coerce_str {
my $val = shift;
$val =~ s/\W/_/g;
return $val;
}
}
{
package main;
use strict;
use warnings;
use Test::More qw/no_plan/;
new_ok( 'My::Class' => [ values => [ 'valid' ] ]); #ok
new_ok( 'My::Class' => [ values => [ qw/valid valid still_valid/ ] ]); #ok
new_ok( 'My::Class' => [ values => 'valid' ]); # ok
new_ok( 'My::Class' => [ values => [ 'invalid; needs some coercion - ^&%&^' ] ]); #not ok
new_ok( 'My::Class' => [ values => 'invalid; needs some coercion - ^&%&^' ]); # not ok
cmp_ok( My::Class::coerce_str('invalid; needs some coercion - ^&%&^'), 'eq', 'invalid__needs_some_coercion________', 'properly coerces strings'); #ok
}
按原样运行会给我以下内容。问题不在于验证，而是我没有明确定义我的强制，我不确定我缺少什么：
ok 1 - The object isa My::Class
ok 2 - The object isa My::Class
ok 3 - The object isa My::Class
not ok 4 - new() died
# Failed test 'new() died'
# at testcoercion.pl line 63.
# Error was: Attribute (values) does not pass the type constraint because: Validation failed for 'ArrayRefofCustomTypes' with value [ "invalid; needs some coercion - ^&%&^" ] at C:/strawberry/perl/site/lib/Moose/Meta/Attribute.pm line 1131
<< cut >>
not ok 5 - new() died
# Failed test 'new() died'
# at testcoercion.pl line 64.
# Error was: Attribute (values) does not pass the type constraint because: Validation failed for 'ArrayRefofCustomTypes' with value "invalid; needs some coercion - ^&%&^" at C:/strawberry/perl/site/lib/Moose/Meta/Attribute.pm line 1131
<< cut >>
ok 6 - properly coerces strings
1..6
# Looks like you failed 2 tests of 6.
答案 0 :(得分：2)
你使用的一切都应该可以正常工作。例如，考虑这个测试：
my $customtype = Moose::Util::TypeConstraints::find_type_constraint('CustomType');
print "'a' validates as customtype? ", ($customtype->check('a') ? 'yes' : 'no'), "\n";
my $arraytype = Moose::Util::TypeConstraints::find_type_constraint('ArrayRefofCustomTypes');
print "[ 'a' ] validates as array? ", ($arraytype->check([ 'a' ]) ? 'yes' : 'no'), "\n";
{
package Class;
use Moose;
has 'values' => ( is => 'ro', required => 1,
isa => 'ArrayRefofCustomTypes',
coerce => 1,
);
}
my $obj = Class->new(values => 'a');
print $obj->dump(2);
打印：
'a' validates as customtype? yes
[ 'a' ] validates as array? yes
$VAR1 = bless( {
'values' => [
'a'
]
}, 'Class' );
结论：如果您遇到问题，则会出现在其他一些代码中。你能粘贴一些无法正常工作的代码吗？
答案 1 :(得分：2)
所以是的，强制需要从基类型明确定义到您想要采用的所有输入排列的自定义类型。将强制和验证代码移出到子例程有助于防止代码重复，但不能完全消除它。以下代码按照我的预期运行，并附有TAP计划来证明它。
虽然它虽然有效，但我并不完全相信它是处理这类事情的预定方式。它正在进行大量从基类型到arrayref自定义类型的显式转换，如果访问器接受多种强制类型，我不确定它在更大的上下文中的工作情况。
编辑：实际上，此时coerce 'ArrayRefofCustomTypes' => from 'CustomType'完全没必要，=> from 'Str'将处理有效和无效的输入。
{
package My::Class;
use strict;
use warnings;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'CustomType'
=> as 'Str'
=> where { validate_cust($_) }
;
coerce 'CustomType'
=> from 'Str'
=> via { coerce_str_to_cust($_) }
;
subtype 'ArrayRefofCustomTypes'
=> as 'ArrayRef[CustomType]'
;
coerce 'ArrayRefofCustomTypes'
=> from 'CustomType'
=> via { [ $_ ] }
=> from 'ArrayRef[Str]'
=> via { [ map { coerce_str_to_cust($_) } @$_ ] }
=> from 'Str'
=> via { [ coerce_str_to_cust($_) ] }
;
has 'values' => ( is => 'ro', required => 1,
isa => 'ArrayRefofCustomTypes',
coerce => 1,
);
sub validate_cust {
my $val = shift;
if ($val =~ /^\w+$/) {
return 1;
}
return ();
}
sub coerce_str_to_cust {
my $val = shift;
my $coerced = $val;
$coerced =~ s/\s/_/g;
if (validate_cust($coerced)) {
return $coerced;
}
else {
return $val;
}
}
}
{
package main;
use strict;
use warnings;
use Test::More tests => 12;
use Test::Exception;
new_ok( 'My::Class' => [ values => [ 'valid' ] ]);
new_ok( 'My::Class' => [ values => [ qw/valid valid still_valid/ ] ]);
new_ok( 'My::Class' => [ values => 'valid' ]);
new_ok( 'My::Class' => [ values => [ 'invalid and needs some coercion' ] ]);
new_ok( 'My::Class' => [ values => 'invalid and needs some coercion' ]);
new_ok( 'My::Class' => [ values => [ 'valid', 'valid', 'invalid and needs some coercion' ] ]);
throws_ok { my $obj = My::Class->new( values => [ q/can't be coerced cause it has &^%#$*&^%#$s in it/ ] ); } qr/Attribute \(values\) does not pass the type constraint because: Validation failed/, 'throws exception on uncoercible input';
my $uncoercible = q/can't be coerced cause it has &^%#$*&^%#$s in it/;
cmp_ok( My::Class::coerce_str_to_cust('invalid and needs some coercion'), 'eq', 'invalid_and_needs_some_coercion', 'properly coerces strings');
cmp_ok( My::Class::coerce_str_to_cust($uncoercible), 'eq', $uncoercible , 'returns uncoercible strings unmodified');
ok( My::Class::validate_cust('valid'), 'valid string validates');
ok( My::Class::validate_cust(My::Class::coerce_str_to_cust('invalid and needs some coercion')), 'coerced string validates');
ok( !My::Class::validate_cust('invalid and needs some coercion'), "invalid string doesn't validate");
}