代码之家 › 专栏 › 技术社区 › Håkon Hægland

创建自定义Moose属性类型

moose perl

Håkon Hægland · 技术社区 · 8 年前

我正在尝试为我的 Moose 课程。例如,考虑一类可以标记为 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;

假设属性 some_attribute 班级的 MyPkg 属于一组可以标记的属性 私有的 ,其中 私有的 例如 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 );

这是否可能与 驼鹿 ?

1 回复 | 直到 8 年前

Håkon Hægland 8 年前

根据 Moose::Manual::Attribute :

如果有许多属性仅因名称不同,则可以立即声明所有内容:
package Point;  
use Moose;

has [ 'x', 'y' ] => ( is => 'ro', isa => 'Int' );
还有,因为 has 只是一个函数调用,您可以在循环中调用它:
for my $name ( qw( x y ) ) {  
    my $builder = '_build_' . $name;  
    has $name => ( is => 'ro', isa => 'Int', builder => $builder );
}

还有一个 lazy_build 属性,请参见 Moose::Meta::Attribute ,但文件上说: “请注意,强烈建议不要使用此功能”

最后一个选项是使用扩展包。我想这已经存在于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;