Perl で楽々アクセサ作成について考えてみた - その 2

「Perl で楽々アクセサ作成について考えてみた」にて、Perl でアクセサを作成する方法について考えてみつつ、どうにもならんのでハテナオヤメソッドNDO メソッドにより教えを請うてみたところ、コメント欄にて Perl ハカーの方々がいろいろ御教示くださり、大変にありがたい気持ちでいっぱいであります。インターネット最高！

さて、コメント欄では、以下の点につき御教授いただきました。

1. $obj->autor_name よりも $obj->autor->name の方がそれっぽいし、また、実装も簡単なのではないか
2. いちいち __PACKAGE__->mk_accessors するの面倒くさい
3. まかまかさんによるコード例
4. 山科氷魚さんによるコード例

1 点目については、そうするほうがいいのかなー、と思ったりもしたのですが、ちょっと考えてみたところ、難しくて僕の手には負えないかなぁという気がして、先のエントリで試したような形にしてみたのでした。

また、2 点目については、今回の多階層のハッシュには対応してはいないものの、CPAN に Class::AutoAccess というモジュールがあり、これは AUTOLOAD を利用してアクセサを自動生成するものなのですが、アプローチとしてはこういう方法もありかな、というか、次回のエントリで触れようかなぁと思っていたりもしてたのでした。

んでもって、まかまかさんのコードを見て「きたーーーーーーーーーーーーーー！！！」と感激しまくり。「こうすればいいのかー。こういうのがまさにプログラミングってやつなんだなぁ。素晴らしいなぁ。僕ももっと精進して、まともにプログラミングできるようになりたいなぁ」と思いましたよ！ んでもって山科氷魚さんのコードを見て、UNIVERSAL の AUTOLOAD メソッドを定義することでメソッドコールの連鎖に対処するやり方に感嘆。すげーなぁ。

そこで、御教授いただいたやり方や、先に挙げた Class::AutoAccess を総合して、以下のようなコードを書いてみました。Class::Accessor の仕様からはちょっとはずれてしまったので Class::AutoAccess::Linked ってな名前に、とりあえずしてみました。それでもまぁ、アクセサを楽々作成という観点から見ると、これはこれでいい感じかなぁと思ったり。

package Class::AutoAccess::Linked;

use strict;

use Carp ();

our $AUTOLOAD;
our $VERSION = '0.01';

sub new {
    my ($class, $fields) = @_;
    bless $fields || {}, $class;
}

sub AUTOLOAD {
    my $self = shift;
    (my $field = $AUTOLOAD) =~ s/.*:://;

    return if $field eq 'DESTROY';
    $self->_croak("Field $field does not exists")
        unless exists $self->{$field};

    if (@_) {
        $self->{$field} = $self->_get_linkedobj($_[0]);
    }
    else {
        $self->{$field} = $self->_get_linkedobj($self->{$field});
    }

    return $self->{$field};
}

sub _get_linkedobj {
    my ($self, $value)  = @_;

    if (ref($value) eq 'HASH'){
        return __PACKAGE__->new($value);
    }
    else {
        return $value;
    }
}

sub _croak {
    my ($self, $msg) = @_;
    Carp::croak($msg || $self);

    return;
}

package MyClass;

use base qw(Class::AutoAccess::Linked);

sub new {
	bless {
	    title  => 'Class::Accessor::Deep',
	    desc   => 'Create accessors reach deep inside',
	    author => {
	        name     => 'Kentaro Kuribayashi',
	        homepage => {
	            title  => 'antipop.gs',
	            uri    => 'http://antipop.gs/',
	        },
	        modulelist => [qw(
	            Acme::MorningMusume
	            WebService::Hatena::Fotolife
	        )],
	    },
	}, shift;
}

package main;

my $obj = MyClass->new;

print $obj->author->name, "\n";
print join ', ', @{$obj->author->modulelist}, "\n";
print $obj->author->homepage->uri, "\n";
print $obj->title, "\n";
print $obj->desc, "\n";

$obj->author->name('Makamaka');
$obj->author->modulelist([qw(JSON Acme::Oil)]);
$obj->author->homepage->uri('http://www.donzoko.net');

print $obj->author->name,"\n";
print $obj->author->homepage->uri,"\n";
print join ', ', @{$obj->author->modulelist}, "\n";

__END__

いろいろ教えてくださった皆様、本当にありがとうございます！！！！！！！！！

「Perl で楽々アクセサ作成について考えてみた - その 3」に続く。