Perl で楽々アクセサ作成について考えてみた
Perl でオブジェクトのアトリビュートへのアクセサを書くとしたら、たとえば以下ように、アクセスしたいアトリビュートの分だけアクセサをひたすら書きまくることもできる。
package MyClass;
sub new {
my $class = shift;
bless {
foo => 'aaa',
bar => 'bbb',
}, $class;
}
sub foo {
my $self = shift;
if (@_) {
$self->{foo} = $_[0];
}
else {
return $self->{foo};
}
}
sub bar {
my $self = shift;
if (@_) {
$self->{bar} = $_[0];
}
else {
return $self->{bar};
}
}
...
これはいかにも面倒くさいし、また、同じようなコードが羅列されており、無駄なことしてる感が強まりまくっている(まぁこれはあくまでも例で、普通こんなコードは書かないと思いますがw)。そこで、Class::Accessor を用いると、以下のようにして簡単にアクセサを作ることができる。
package MyClass;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(foo bar));
package main;
my $obj = MyClass->new;
$obj->foo('aaa'); # set
$obj->foo; # get
$obj->bar('bbb'); # set
$obj->bar; # get
ここまでは常識っつーかまぁ普通そうだよね的な話。
さて、ここで MyClass オブジェクトが以下のようなデータ構造を持ち得るとする。
{
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
)],
},
}
個々のアトリビュートへのアクセサを作成するなら、前述の通り Class::Accessor を用いて、さくっとやっちゃえば済む話ではあるが、上の例にそって説明すると、author アトリビュートが保持するハッシュリファレンス内部の値についても、たとえば $obj->author_homepage_title;
などとしてアクセスできると便利なのではないかと思った。以下のような感じ。
package MyClass;
use base qw(Class::Accessor::Deep);
__PACKAGE__->mk_accessors(qw(
title
desc
author_name
author_mail
author_homepage_title
author_homepage_uri
author_modulelist
));
package main;
my $obj = MyClass->new;
$obj->title # or $obj->title('some value');
$obj->desc; # or $obj->desc('some value');
$obj->author_name; # or $obj->author_name('some value');
$obj->author_mail; # or $obj->author_mail('some value');
$obj->author_homepage_title; # or $obj->author_homepage_title('some value');
$obj->author_homepage_uri; # or $obj->author_homepage_uri('some value');
$obj->author_modulelist; # or $obj->author_modulelist('some value');
要するに、ハッシュリファレンスの階層を下るにつれ、key を "_"(アンダースコア)でつないだものをアクセサとして作成してみてはどうか、ということだ。MyClass の親クラスとして、上記コードに出てくる Class::Accessor::Deep は以下の通り。
package Class::Accessor::Deep;
use strict;
use base qw(Class::Accessor);
our $VERSION = '0.01';
sub set {
my($self, $key) = splice(@_, 0, 2);
my $target = _prepare_target($key);
if (@_ == 1) {
eval "$target = '$_[0]'";
}
elsif (@_ > 1) {
my $value = "['" . join("', '", @_) . "']";
eval "$target = $value";
}
else {
$self->_croak("Wrong number of arguments received");
}
}
sub get {
my $self = shift;
my $target;
if (@_ == 1) {
$target = _prepare_target($_[0]);
return eval "$target";
}
elsif ( @_ > 1 ) {
my @values;
for my $key (@_) {
$target = _prepare_target($key);
push @values, eval "$target";
}
return @values
}
else {
$self->_croak("Wrong number of arguments received");
}
}
sub _prepare_target {
my $key = shift;
my $target = '$self->';
for my $piece (split '_', $key) {
$target .= "{$piece}";
}
return $target;
}
1;
要は、Class::Accessor を継承して、"_"(アンダースコア)でつながれた引数を分解して自身のデータのアトリビュートへのアクセサへ変換するよう、set, get メソッドをオーバーライドしている。とりあえず思いつきでぱっと書いてみたものなので、Class::Accessor::Deep には以下の問題点がある。
- hash の key に "_"(アンダースコア)を使うことができない
- set メソッドは引数に文字として評価できるもの、あるいはそれらのリストしか受け付けない
ひとつめの問題点については、hash の key をなんらかの方法でつないでメソッド名としなければならないのだが、perl の識別子は基本的に [a-zA-Z0-9_] でないとならないので(回避する手法はあるみたいだけど)、わりとしかたない感じ? 二番目については、eval するときの処理を手抜きしているせい。まぁ、その他にも問題点はいろいろあるけど。上記 2 点のうち、"_"(アンダースコア)を使えないってのはかなり痛いなーという気がする。回避できる策があるかもしれないけれど、うまい方法を思いつかなかった。
というか、長々とどうでもいいことをぐだぐだと書いていて、ここまで読んだ奇特な方は「おまえはいったいなにがいいたいんだ」的マジギレ寸前状態に陥っていると思われますが、要は、必要に迫られてそれを解決し得るかもしれないモジュールを思いつきのままに書いてみたけれど、どうもうまくいかんなー、どうしよう……こりゃぁお蔵入りネタになりそうだ……でももったいないなぁ。じゃぁとりあえずわからないままにエントリとして投げたりしたら Perl ハカーな方がいい方法を教えてくれるかもしれない、ってなメソッドを、いま、駆使してみているわけです。
というかまぁ、$obj->author_homepage_title; とかでアクセスできたところで、それが便利かっつーと微妙という気もするわけだが……。