Moose 深度强制 - 用户定义类型的 ArrayRef答案

【问题标题】：Moose deep coercion - ArrayRef of user-defined typesMoose 深度强制 - 用户定义类型的 ArrayRef
【发布时间】：2011-06-22 16:40:20
【问题描述】：

我在以下子类型和强制链中缺少什么？我希望能够强制验证类型的 arrayref 或从以下输入中死亡：

强制字符串
有效字符串
混合强制和有效字符串的 Arrayref

假设所有类型都是完全命名空间的，并且未声明的函数 validate 和 coerce_str 分别验证（返回布尔值）和强制并从输入中返回一个有效字符串。

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.

【问题讨论】：

一个注释——我怀疑添加coerce 'ArrayRefofCustomTypes' => from 'ArrayRef[Str]' via => {} 并复制我的强制代码但将其粘贴到 arrayref 容器中会处理它，但这会复制整个字符串->自定义类型转换代码。通过重新阅读文档，我怀疑这就是必须明确定义所有转换的含义，但我讨厌重复这样的代码。

标签： perl moose coercion

【解决方案1】：

您使用的一切都应该可以正常工作。例如，考虑这个测试：

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

结论：如果你遇到问题，那是在其他一些代码中。你能粘贴一些没有按预期工作的代码吗？

【讨论】：

当然；更新了完整的代码。编辑：实际上；打击一下，那个仓促写的人为例子不好。
帮助强制使用 s///g 但这仍然不能解决问题；代码已更新。

【解决方案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");
}

【讨论】：