自动生成 moose 属性包装器方法

Question

是否可以为 moose 属性提供访问器包装器，而不必每次都编写它？

示例： * 有一个 TkRef 类型的属性 * 它应该提供一个用于设置值的包装器 * 定义属性时要定义包装器的名称 * 我不想写包装器

我想是这样的：

has _some_val => (
  is => 'rw',
  isa => 'TkRef',
  coerce => 1,
  init_arg => 'my_accessor_wrapper_name',
  default => 'default value'
);

# Later in the class:
sub some_public_method {
  my $self = shift;
  # will set _some_val behind the scenes:
  $self->my_accessor_wrapper_name('this will be the new value');
  ...
}

Answer 1

我在这里假设这是从your previous question 开始的，因此目的是包装 ScalarRef 属性的访问器，以确保在使用新的 ScalarRef（或可以强制转换为 ScalarRef 的东西）调用 setter 时，而不是发生通常的设置操作，而是将存储在新标量中的字符串复制到旧标量中。

有比下面更简单的方法（例如，为has 编写包装器），但我认为这是“最有角的”：

use 5.010;
use strict;
use warnings;

{
    package MooseX::Traits::SetScalarByRef;
    use Moose::Role;
    use Moose::Util::TypeConstraints qw(find_type_constraint);

    # Supply a default for "is"
    around _process_is_option => sub
    {
        my $next = shift;
        my $self = shift;
        my ($name, $options) = @_;

        if (not exists $options->{is})
        {
            $options->{is} = "rw";
        }

        $self->$next(@_);
    };

    # Supply a default for "isa"
    my $default_type;
    around _process_isa_option => sub
    {
        my $next = shift;
        my $self = shift;
        my ($name, $options) = @_;

        if (not exists $options->{isa})
        {
            if (not defined $default_type)
            {
                $default_type = find_type_constraint('ScalarRef')
                    ->create_child_constraint;
                $default_type
                    ->coercion('Moose::Meta::TypeCoercion'->new)
                    ->add_type_coercions('Value', sub { my $r = $_; \$r });
            }
            $options->{isa} = $default_type;
        }

        $self->$next(@_);
    };

    # Automatically coerce
    around _process_coerce_option => sub
    {
        my $next = shift;
        my $self = shift;
        my ($name, $options) = @_;

        if (defined $options->{type_constraint}
        and $options->{type_constraint}->has_coercion
        and not exists $options->{coerce})
        {
            $options->{coerce} = 1;
        }

        $self->$next(@_);
    };

    # This allows handles => 1
    around _canonicalize_handles => sub
    {
        my $next = shift;
        my $self = shift;

        my $handles = $self->handles;
        if (!ref($handles) and $handles eq '1')
        {
            return ($self->init_arg, 'set_by_ref');
        }

        $self->$next(@_);
    };

    # Actually install the wrapper
    around install_delegation => sub
    {
        my $next = shift;
        my $self = shift;

        my %handles = $self->_canonicalize_handles;
        for my $key (sort keys %handles)
        {
            $handles{$key} eq 'set_by_ref' or next;
            delete $handles{$key};
            $self->associated_class->add_method($key, $self->_make_set_by_ref($key));
        }

        # When we call $next, we're going to temporarily
        # replace $self->handles, so that $next cannot see
        # the set_by_ref bits which were there.
        my $orig = $self->handles;
        $self->_set_handles(\%handles);
        $self->$next(@_);
        $self->_set_handles($orig);  # and restore!
    };

    # This generates the coderef for the method that we're
    # going to install
    sub _make_set_by_ref
    {
        my $self = shift;
        my ($method_name) = @_;

        my $reader = $self->get_read_method;
        my $type   = $self->type_constraint;
        my $coerce = $self->should_coerce;

        return sub {
            my $obj = shift;
            if (@_)
            {
                my $new_ref = $coerce
                    ? $type->assert_coerce(@_)
                    : do { $type->assert_valid(@_); $_[0] };
                ${$obj->$reader} = $$new_ref;
            }
            $obj->$reader;
        };
    }
}

{
    package Local::Example;
    use Moose;
    use Moose::Util::TypeConstraints;

    subtype 'TkRef', as 'ScalarRef';
    coerce 'TkRef', from 'Str', via { my $r = $_; return \$r };

    has _some_val => (
        traits   => [ 'MooseX::Traits::SetScalarByRef' ],
        isa      => 'TkRef',
        init_arg => 'some_val',
        default  => 'default value',
        handles  => 1,
    );
}

use Scalar::Util qw(refaddr);

my $eg = Local::Example->new;
say refaddr($eg->some_val);

$eg->some_val("new string");
say refaddr($eg->some_val), " - should not have changed";

say ${ $eg->some_val };