理系学生日記

おまえはいつまで学生気分なのか

ハッシュに対する Accessor を作った

こんなハッシュリファレンスを、

my $h = {
    a => {
        b => 'bbb',
        c => {
            d => 'ddd',
            e => 'eee'
        }
    }
};

こんな風にアクセスしたいと思いました。

my $o = Class::Accessor::Hash->new({ data => $h });
$o->a->b;    # 'bbb'
$o->a->c->d; # 'ddd'

でとりあえずこんな感じかなって思って作って、作った後でもしかしたらもう CPAN にあるかなーって思ってたらやっぱしあって、id:antipop さんが作られていたのでした*1

車輪の再発明になっちゃったなーとか思ったんですけど、上記エントリで antipop さんが仰られている

1. Class::AutoAccessor::Deep は、元はといえば Class::Accessor や Class::AutoAccess に着想を得たものなので、それらにならい、フィールドへの無制限なアクセスを許さないようにした。よって、$AUTOLOAD に含まれるメソッド名をチェックして、未定義のフィールドへのアクセスに対してエラーを返さなければならない
2. ネストされたハッシュリファレンスを階層をたどって Class::AutoAccess::Deep オブジェクトとして bless するのはまぁいいとして、AUTOLOAD 済メソッドを単にラクダ本のようにして、あるいは dan 氏が示したような方法で保存することはできない。そのような方法では、未定義なメソッドへのアクセスを許さないという、1 点目の要求を満たさない

という気持ちはスゴい分かって、AUTOLOAD は呼び出したくないけど、AUTOLOAD を呼び出さないようにすると未定義のフィールドへのアクセスでエラーを返さない場合ができてしまう*2


確かにそれは何とかしたいなって思って、取り急ぎ書いてみたのでした。書いてみてたら、明日仕事なのにヤバいくらい遅い時間になった。
AUTOLOAD を呼ばなくなるのは良いんだけど、現状ではハッシュの階層を辿るたびにオブジェクトがムダに生成されてしまっていて、AUTOLOAD 呼びだす方がよっぽど速いんじゃないかと思います。なんとかしようと思ったけど、さすがにもう寝ないと…!!

package Class::Accessor::Hash;

use strict;
use warnings;
use Carp;

sub new {
    my ($class, $ref) = @_;

    my $data  = $ref->{data} or croak "data must be specified";
    my $stack = $ref->{stack} || [];
    bless { 
        data  => $data,
        stack => $stack,
    }, $class;
}

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

    my $ref = $self->{data};
    for my $f (@{ $self->{stack} }) {
        $ref = $ref->{$f};
    }
    $ref;
}

sub AUTOLOAD {
    my $self   = shift;
    my $method = our $AUTOLOAD;

    my ($field) = $method =~ /.*::(.*)/o;
    $field eq 'DESTROY' and return;

    {
        no strict 'refs';
        *{$method} = sub {
            my ($self, $arg) = @_;

            my $ref = $self->_follow_stack;
            if ( ref $ref->{$field} eq 'HASH' ) {
                __PACKAGE__->new({
                    data  => $self->{data},
                    stack => [ @{$self->{stack}}, $field ]
                });
            }
            elsif ( exists $ref->{$field} ){
                $ref->{$field};
            }
            else {
                croak "$field does not exist\n";
            }
        };
        $self->$field;
    }
}

1;

*1:トラバ先間違えました。。すみなせん

*2:ハッシュの中の異なる階層に同じキーがある場合