深い強制強制 - ユーザー定義型のArrayRef

Question

次のサブタイプと強制変換チェーンでは、何が欠けていますか？

• 強制可能文字列混合強制可能の
• 有効な文字列
• 配列リファレンスおよび有効な文字列

：私は検証型の配列リファレンスを強制するか、次の入力から死ぬできるようにしたいと思いますすべての型が完全に名前空間を持ち、宣言されていない関数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, 
       ); 

私はカスタムタイプの作品を知っています。私はそれを属性として定義し、強制的な文字列または既に有効な文字列を使用してオブジェクトを初期化することができます。どのようにすればよいかわからないのは、渡された配列リファレンスをコンストラクタから掘り下げて明示的に処理し、含まれているすべての文字列を個別に検証することです。私は深い強制（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. 

Answer 1

ですから、入力のすべての順列について、強制的に基底型からカスタム型に厳密に定義する必要があります。強制と検証コードをサブルーチンに移すことは、コードの重複を防ぐのに役立ちますが、完全に排除するわけではありません。次のコードは、私が期待しているように、それを証明する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"); 
} 

Answer 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'); 

結論：たとえば、このテストを考慮する問題が発生した場合、それはいくつかの他のコードです。あなたが期待どおりに動作していないいくつかのコードを貼り付けることはできますか？