自動生成駝鹿屬性包裝方法

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屬性的訪問器，以確保當調用setter時使用新的ScalarRef（或者可以強制轉換爲ScalarRef的東西），而不是通常的設置動作發生，您將存儲在新標量中的字符串複製到舊標量中。

有更簡單的方法來做到這一點比低於（比如，通過寫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 };