创建自定义 Moose 属性类型

Question

我正在尝试为我的 Moose class 简化 class 属性的定义。例如，考虑一个 class 属性可以标记为 private，这里是一个这样的属性的例子：

package MyPkg;
use Moose;

has some_attribute => (
    is       => 'ro',
    isa      => 'Str',
    lazy     => 1,
    init_arg => undef, # prevent from being set by constructor
    builder  => "_set_some_attribute"
);

sub _set_some_attribute {
    my ( $self ) = @_;

    return "value_of_some_attribute";
}

sub some_method_that_uses_some_attribute {
    my ( $self ) = @_;

    return "The value of some attribute: " . $self->some_attribute;
}

package main;

use feature qw(say);
use strict;
use warnings;

my $o = MyPkg->new();    
say $o->some_method_that_uses_some_attribute;

假设 class MyPkg 的属性 some_attribute 属于一组可以标记为 private 的属性，其中所有类型为 private 例如 lazy 并且不能由构造函数设置。也就是说，我想简化：

package MyPkg;
use Moose;
has some_attribute => (
    is       => 'ro',
    isa      => 'Str',
    lazy     => 1,
    init_arg => undef, # prevent from being set by constructor
    builder  => "_set_some_attribute"
);

像这样

package MyPkg;
use Moose;
use MyMooseAttributeExtensions; # <-- some Moose extension that I have to write
has some_attribute => (is => 'ro', isa => 'Str', private => 1 );

Moose可以吗？

Answer 1

根据Moose::Manual::Attribute：

If you have a number of attributes that differ only by name, you can declare them all at once:
package Point;  
use Moose;

has [ 'x', 'y' ] => ( is => 'ro', isa => 'Int' );
Also, because has is just a function call, you can call it in a loop:
for my $name ( qw( x y ) ) {  
    my $builder = '_build_' . $name;  
    has $name => ( is => 'ro', isa => 'Int', builder => $builder );
}

还有一个lazy_build属性，见Moose::Meta::Attribute，但文档说："Note that use of this feature is strongly discouraged"

最后一个选择是使用扩展包。我想这已经存在于 CPAN 的某处，但我找不到它，所以这是我尝试实现 Moose 扩展：

package MyMooseAttributeExtensions;
use strict;
use warnings;

our %orig_has;  # save original 'has' sub routines here

sub import {
    my $callpkg = caller 0;
    {
        no strict 'refs';
        no warnings 'redefine';
        $orig_has{$callpkg} = *{$callpkg."::has"}{CODE};
        *{$callpkg."::has"} = \&private_has;
    }
    return;
}

sub private_has {
    my ($attr, %args) = @_;

    my $callpkg = caller 0;
    if (exists $args{private} ) {
        delete $args{private};
        %args = (
            %args,
            lazy     => 1,
            init_arg => undef, # prevent from being set by constructor
            builder  => "_set_$attr"
        );
    }
    $orig_has{$callpkg}->($attr, %args);
}

1;

创建自定义 Moose 属性类型

Create custom Moose attribute type

perl

moose