从属性中获取属性值

时间:2012-04-13 01:23:56

标签: perl metaprogramming moose

在Moose扩展中我写的是我试图从属性中访问属性值,而不通过访问器,但我似乎无法做到这一点。

我正在尝试编写此代码

{
    package Test;
    use Moose;
    use MooseX::RemoteName; #provides magic

    has attr0 => (
        isa         => 'Bool',
        is          => 'ro',
        default     => sub { 1 },
        serializer  => sub {
           my $s = shift;
           return $s->get_value( $s ) ? 'Y' : 'N';
        }, 
    );

    has attr1 => (
       isa => 'Str',
       is  => 'ro',
    )
}

这样我就可以(从我的测试中)

my $t0 = Test->new({ attr1 => 'foo' });

isa_ok my $attr0 = $t0->meta->get_attribute('attr0'), 'Class::MOP::Attribute';
is $attr0->serialized,  'Y',    'remote_name serializes';

isa_ok my $attr1 = $t0->meta->get_attribute('attr1'), 'Class::MOP::Attribute';
is $attr1->serialized,  'foo',    'remote_name serializes'; # undef

这就是我在扩展程序中尝试的内容

has serializer => (
    isa       => 'CodeRef',
    is        => 'ro',
    lazy      => 1,
    default   => sub {
        return sub {
            my $arg = shift;
            return $arg->get_value( $arg->associated_class );
        }
    },
);

sub serialized {
    my $self = shift;

    my $coderef = $self->serializer;

    return &$coderef( $self );
}

1 个答案:

答案 0 :(得分:0)

我的问题似乎有两个问题,我的匿名子程序没有正确完成,我需要将对象的实例传递给匿名子程序。

这似乎适用于我的Moose Extension

has serializer => (
    predicate => 'has_serializer',
    traits    => ['Code'],
    is        => 'ro',
    default   => sub {
        return sub {
            my ( $self, $instance ) = @_;
            return $self->get_value( $instance );
        }
    },
    handles   => {
        serializing => 'execute_method',
    },
);

sub serialized {
    my ( $self, $instance ) = @_;

    return $self->serializing( $instance );
}

然后允许我写下面的(略有不同)

package Test;
use Moose;
use MooseX::RemoteName;

has attr0 => (
    isa        => 'Bool',
    is         => 'ro',
    lazy       => 1,
    default    => sub { 1 },
    serializer => sub {
        my ( $attr, $instance ) = @_;
        return $attr->get_value( $instance ) ? 'Y' : 'N';
    },
);

将通过此测试而不会出现问题

subtest t0 => sub {
    my $t = Test->new;

    is $t->attr0, 1, 'attr0 is 1';

    isa_ok my $attr0 = $t->meta->get_attribute('attr0'), 'Class::MOP::Attribute';

    is $attr0->serialized( $t ),  'Y',    'attr0 serializes';
    isa_ok $t, 'Test';
};

我想我可以直接传递实例,但我不完全确定为什么get_value需要它。