perl – Moose从单个参数构造对象

我已经和Moose讨论了大约七个月而且Perl只是稍长一点,但是无法弄清楚如何通过为每个属性提供一个参数来构造类中的几个属性,而不是它们的整个hashref.我已经广泛搜索了文档和网页,但我要么找错了单词,要么遗漏了一些东西.

我已经使设计更加通用了.通过以下基本设置：

package First;
use Moose;
use Second::Type1;
use Second::Type2;
has 'type1' => (
  is => 'rw',isa => 'Second::Type1',default => sub {Second::Type1->new(name => 'random')}
);

has 'type2' => (
  is => 'rw',isa => 'Second::Type2',default => sub {Second::Type2->new(name => 'random')}
);

package Second::Type1;
use Moose;
use This;
has 'name' => (
  is => 'rw',isa => 'Str',required => 1,);
has 'this' => (
  is => 'rw',isa => 'This',default => sub {This->new()}
);
# package has more attributes,but you get the idea
__PACKAGE__->meta->make_immutable();
no Moose;
1;

package Second::Type2;
use Moose;
use That;
has 'name' => (
  is => 'rw',);
has 'that' => (
  is => 'rw',isa => 'That',default => sub {That->new()}
);
# package has more attributes,but you get the idea
__PACKAGE__->meta->make_immutable();
no Moose;
1;

我希望能够通过以下方式构建First：

use First;
my $first = First->new(type1 => 'foo',type2 => 'bar');

其中’foo’等于Second :: Type1的’name’属性的值,’bar’等于Second :: Type2的’name’属性的值.

现在关于我自己的解决方案,我(已成功)制作了一个Moose :: Role,它只包含一个’around BUILDARGS’子,然后使用Factory类(其内容与IMO无关)：

package Role::SingleBuildargs;

use Moose::Role;
use Factory::Second;
requires 'get_supported_args';

around BUILDARGS => sub {
my ($class,$self,%args) = @_;
my @supported_args = $self->get_supported_args;
my $factory = Factory::Second->new();
    my @errors = ();
    foreach my $arg (sort {$a cmp $b} keys %args) {
        if (grep {$_ eq $arg} @supported_args) {
            my $val = $args{$arg};
            if (!ref $val) {    # passed scalar init_arg
                print "$self (BUILDARGS): passed scalarn";
                print "Building a Second with type '$arg' and name '$val'n";
                $args{$arg} = $factory->create(type => $arg,name => $val)
            } elsif (ref $val eq 'HASH') {  # passed hashref init_arg
                print "$self (BUILDARGS): passed hashref:n";
                my %init_args = %$val;
                delete $init_args{name} unless $init_args{name};
                $init_args{type} = $arg;
                $args{$arg} = $factory->create(%init_args);
            } else {    # passed another ref entirely
                print "$self (BUILDARGS): cannot handle reference of type: ",ref $val,"n";
                die;
            }
        } else {
            push @errors,"$self - Unsupported attribute: '$arg'";
        }
    }
    if (@errors) {
        print join("n",@errors),"n";
        die;
    }
    return $self->$class(%args);
    };

no Moose;
1;

然后我在First类和First等其他类中使用该角色.

我也尝试过胁迫：

package Role::Second::TypeConstraints;
use Moose::Util::TypeConstraints

subtype 'SecondType1',as 'Second::Type1';
subtype 'SecondType2',as 'Second::Type2';
coerce 'SecondType1',from 'Str',via {Second::Type1->new(name => $_};
coerce 'SecondType2',via {Second::Type2->new(name => $_};

no Moose::Util::TypeConstraints;
1;

并修改了第一个包(仅列出更改)：

use Role::Second::TypeConstraints;
has 'type1' => (
   isa => 'SecondType1',coerce => 1,);
has 'type2' => (
   isa => 'SecondType2',);

然而,那是行不通的.如果有人能解释原因,那就太好了.

至于实际问题：在课堂上获得这种行为的最佳方法是什么？真的没有比修改BUILDARGS更好的方法了,或者我错过了什么(关于Moose :: Util :: TypeConstraints,也许)？ TMTOWTDI和所有,但我的效率根本不高.

编辑：编辑一致性(混合通用类名)

use Moose::Util::TypeConstraints;

coerce 'Second::Type1'
    => from 'Str'
        => via { Second::Type1->new( name => $_ ) };

coerce 'Second::Type2'
    => from 'Str'
        => via { Second::Type2->new( name => $_ ) };

has 'type1' => (
  is      => 'rw',isa     => 'Second::Type1',default => sub { Second::Type1->new },coerce  => 1,);

has 'type2' => (
  is      => 'rw',isa     => 'Second::Type2',default => sub { Second::Type2->new },);

my $first = First->new(type1 => 'foo',type2 => 'bar');