Search code examples
perlmetaprogrammingmoose

Get an attributes value from within the attribute


In the Moose Extension I'm writing I'm trying to access the attributes value from within the attribute, without going through the accessor, but I can't seem to get this right.

I'm trying to be able to write this code

{
    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',
    )
}

so that I can then do (from my test)

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

This is what I'm trying in the extension

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

Solution

  • my problems appear to be two fold, my anonymous subroutines weren't done right, and I needed to pass the instance of the object to the anonymous subroutine.

    This seems to be working in my 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 );
    }
    

    which then allows me to write the following (slightly different)

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

    which will pass this test without issue

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

    I think I can live passing the instance in, though I'm not entirely sure why get_value needs that.