「これぐらい読めるようになれyo!」と、どこかのエントリーで紹介されていたClass::Data::Inheritableのソースを読んでみます。読めるかな・・・ドキドキ
package Class::Data::Inheritable;
use strict qw(vars subs);
use vars qw($VERSION);
$VERSION = '0.04';
sub mk_classdata {
my ($declaredclass, $attribute, $data) = @_;
if( ref $declaredclass ) {
require Carp;
Carp::croak("mk_classdata() is a class method, not an object method");
}
my $accessor = sub {
my $wantclass = ref($_[0]) || $_[0];
return $wantclass->mk_classdata($attribute)->(@_)
if @_>1 && $wantclass ne $declaredclass;
$data = $_[1] if @_>1;
return $data;
};
my $alias = "_${attribute}_accessor";
*{$declaredclass.'::'.$attribute} = $accessor;
*{$declaredclass.'::'.$alias} = $accessor;
}
ソースは上記のようになります。おー短いけど大変そうだぞ。・・・っと、ソースを読む前に説明と使い方を。
- Class::Data::Inheritance はクラスデータ（スタティック変数）へのアクセサとミューテーターを作るクラスとのこと。
- そのデータはサブクラスに継承することができ、サブクラスにオーバライドさせることもできる。
package Hiboma; use base qw(Class::Data::Inheritable); Hiboma->mk_classdata(name => 'hiroya ito'); 1;
Hibomaクラスを作って、アクセサを作ります。アクセサの名前はmk_classdata()メソッドに渡した１つめの引数で作られます。２つめの引数はクラスデーターになります。
use Hiboma; print Hiboma->name() , "\n"; # hiroya ito
クライアントはこのようになります。先ほどセットしたnameアクセサをHibomaクラスで呼び出します。簡単だー！すげー！
さてさて、そろそろモジュールの内部を探検しましょう。勉強なので、コード各行を逐一チェックしていくことにします。
use strict qw(vars subs); use vars qw($VERSION); $VERSION = '0.04';
基本のuse strictから始まります。後半でシンボリックリファレンスを使いたいので、vars と subs だけを strictで見張ります。
use vars でグローバル変数を宣言します（このパッケージ内でグローバル）。$VERISONにはモジュールのヴァージョンを入れます
mk_classdata()メソッドを見ていきます
my ($declaredclass, $attribute, $data) = @_;
if( ref $declaredclass ) {
require Carp;
Carp::croak("mk_classdata() is a class method, not an object method");
}
mk_classdata()はクラスメソッドなので、当然呼び出し元はクラスになります。ref $declaredclass をチェックすることで呼び出し元がクラスかオブジェクト（リファレンス）かをチェックします。オブジェクトだった場合には、require Carp して、croakメソッドで警告を出してあげます。
requireはコード実行時にPerlスクリプトを読み込むものでした。use との違いに気をつけます。
次のコードは
my $accessor = sub {
my $wantclass = ref($_[0]) || $_[0];
return $wantclass->mk_classdata($attribute)->(@_)
if @_>1 && $wantclass ne $declaredclass;
$data = $_[1] if @_>1;
return $data;
};
・・・難所がやって参りました。無名サブルーチンを使っています。クロージャの実装をしているんですね。ここだけ見ても全体の流れが少し分かりにくいので先に残りのコードを見てみます。
my $alias = "_${attribute}_accessor";
*{$declaredclass.'::'.$attribute} = $accessor;
*{$declaredclass.'::'.$alias} = $accessor;
}
先ほどの$accessorに返したクロージャが、シンボリックリファレンスを利用して型グロブに突っ込まれてます.ここの代入のためにシンボリックリファレンスを有効にしてあったようです。ここのコードによって
Class->mk_classdata('hoge')
としたときに
Class->hoge()
というアクセサが利用できるというメカニズム。hoge()アクセサ内での具体的な処理は、先ほどのクロージャを見ればいいようですね。
- ?${attribute}もシンボリックリファレンス？
それではさかのぼって先ほどのクロージャの内側を見てみます。まずは
my $accessor = sub {
my $wantclass = ref($_[0]) || $_[0];
$wantclassにはアクセサ呼び出し元のクラス名が入ります。クラス名を入れたいので、引数がオブジェクトだった場合にはrefを使ってクラス名を抽出してあげます。
次は
return $wantclass->mk_classdata($attribute)->(@_)
if @_>1 && $wantclass ne $declaredclass;
アクセサを呼び出したクラスが、アクセサを宣言したクラスと違った場合は
$wantclass->mk_classdata($attribute)->(@_)
をすることで、呼び出し元のクラスでアクセサを定義して引数を渡します。おそらくここらへんが肝かと。
$declaredclassをクラスデータを保持するスーパークラスと見て、$wantclassをクラスデータを継承するサブクラスと見る。ミューテータとして呼び出されかつ呼び出し元のクラスが宣言元と違う場合は、$wantclass->mk_classdata($attribute)->(@_) をすることでサブクラスがスーパークラスと同一名のアクセサ名を持ち、サブクラス独自のデータをオーバーライドすることになる。ワンライナーで継承しています。
あと、$data , $declaerdclass , $attribute はクロージャ内にいるので、アクセサごとに違う値を保持しているという点も大事だ。呼び出し元が異なれば、それぞれ違う値を返す。またクロージャによってカプセル化もされているので、アクセサ以外の変なところからいじられたりしない。
残りのコードは
$data = $_[1] if @_>1;
return $data;
アクセサへの引数の有無によって、データを読み込みするか書き換えするかを選択します。これはみやがーさんのメルマガのバックナンバーにあった
アクセサを作る場合、Java
などで見られる set_foo(), get_foo() という2種類を用意するのではなく、
foo() というメソッドで set/get 兼用にするのが Perl 流です。
という部分ですかな。
・・・
なんだかんだ言って調べものしながら読んだのでスゴい時間がかかった。細かいところの解釈は間違ってるかもしれないけど、機能を解析できたかなと思う。たった３０行ほどなのにいろんなテクニックが突っ込まれている というのを実感しますた。
