hasの定義を取得する

hasで定義したメソッドのオーバーライドについて - Unknown::Programmingの続きというか。

さて、先日の記事でhasで宣言する時にアクセサの先頭に+をつければ特定のものだけを上書きできることを知ったのですが、そんな便利なものがあるとは知らずに(MooseのPODに書いてたねorz。翻訳版しか見てなかった)作ってしまったものがあるのでとりあえず折角なのでコードだけ張っつけときます。

要はどういうhasで定義されたものかを取得できればいいなぁーと思ったので、ズバリどういうhasで定義されたものかを取得するものを試しに作ってみたわけなのです。

package MooseX::HasRestructure;
use strict;
use warnings;

our $VERSION = 0.01;
our @EXPORT_LIST = qw/
    has_restructure
/;

sub import {
    my $class = caller;
    no strict 'refs';
    for my $func (@EXPORT_LIST) {
        *{"${class}::$func"} = sub ($;%) { &$func($class,@_) }
    }
}

sub unimport {
    my $class = caller;
    no strict 'refs';
    for my $func (@EXPORT_LIST) {
        if ( defined &{"${class}::$func"} ) {
            delete ${"${class}::"}{$func};
        }
    }
}

sub has_restructure {
    my $class  = shift;
    my $method = shift;
    my %has;
    if ( my $attr = $class->meta->find_attribute_by_name($method) ) {
        for my $key ( grep { /^[a-zA-Z]/ } keys %$attr ){
            $has{$key} = $attr->{$key} if exists $attr->{$key};
        }
        $has{default} = $attr->{'$!default'} if exists $attr->{'$!default'};
    }
    wantarray ? %has : \%has;
}

1;

まぁExport周りの実装は適当なのでよろ＞＜

使い方は簡単

package Foo;
use Moose;
use MooseX::HasRestructure;
has foo => (
    is => 'rw',
    lazy => 1,
    required => 1,
    default => sub { 100 }
);

use Data::Dumper;
print Dumper scalar has_restructure('foo');

実行結果

$VAR1 = {
          'required' => 1,
          'default' => sub { "DUMMY" },
          'lazy' => 1,
          'is' => 'rw'
        };

って感じです。

なので派生先のモジュールで、

package Foo;
use Moose;
has foo => (
    is => 'rw',
    lazy => 1,
    required => 1,
    default => sub { 100 }
);

package Bar;
use Moose;
use MooseX::HasRestructure;
extends qw(Foo);
has foo => (
    has_restructure('foo'),
    default => sub { 200 }
);

print Foo->new->foo; # 100
print Bar->new->foo; # 200

こんな感じで、特定のものだけを対象に上書きをすることが出来ます。

まー先頭に+付けるやり方があったのでもはやまったく必要のないものですが＞＜

・・・・いや！一応使い道だってあるよ！なんというかホラ！例えばさ！

package Foo;
use Moose;
has foo => (
    is => 'rw',
    lazy => 1,
    required => 1,
    default => sub { 100 }
);

package Bar;
use Moose;
use MooseX::HasRestructure;
extends qw(Foo);

my %has = has_restructure('foo');
delete $has{lazy}; # lazyを無効に！

has foo => (
    %has,
    default => sub { 200 }
);

みたいな感じでlazyを無効にして且つdefaultだけ上書きとかさ！ホラ！ね！？使い道あるでしょ！？

・・・必要ねー。