27 April 2005
This post may be outdated due to it was written on 2005. The links may be broken. The code may be not working anymore. Leave comments if needed.

Verbiage

It's the second Class. ;)
本来打算要讲的是 Class::Trigger,可得先介绍下 Class::Data::Inheritable
本来打算简单介绍的,可一写就收不了手了。:)

Class::Data::Inheritable - Inheritable, overridable class data - 类数据继承与覆盖。
该模块能将类数据做为一个整体来保存,并且可以被子类继承和覆盖。
该模块里就一个函数:mk_classdata

例子

我们先举个例子(源代码里的例子),然后再分析源代码。
package Pere::Ubu;
use base qw(Class::Data::Inheritable);

Pere::Ubu->mk_classdata('Suitcase');

Pere::Ubu->Suitcase('Red');
my $suitcase = Pere::Ubu->Suitcase;
mk_classdata 能生成 Suitcase 函数并能存取,这点于 Class-Accessor 有点像,但 Class::Data::Inheritable 最主要的功能不在这,在于继承和覆盖。
package Raygun;
use base qw(Pere::Ubu);
  
# Raygun's suitcase is Red.
my $suitcase = Raygun->Suitcase;
这样 Raygun 继承了类 Pere::Ubu 的数据,一旦修改 Pere::Ubu 的数据,Raygun 就会自动改变。
# Both Raygun's and Pere::Ubu's suitcases are now Blue
Pere::Ubu->Suitcase('Blue');
如果 Raygun 想自己控制数据而不随着 Pere::Ubu 的改变而改变的话可以覆盖数据(设置自己的数据)。
# Raygun has an orange suitcase, Pere::Ubu's is still Blue.
Raygun->Suitcase('Orange');
这样以后 Pere::Ubu 改变数据也不会影响 Raygun 了。

源码分析

 =1= sub mk_classdata {
 =2=    my ($declaredclass, $attribute, $data) = @_;

 =3=    my $accessor = sub {
 =4=        my $wantclass = ref($_[0]) || $_[0];

 =5=        return $wantclass->mk_classdata($attribute)->(@_)
                if @_>1 && $wantclass ne $declaredclass;

 =6=        $data = $_[1] if @_>1;
 =7=        return $data;
 =8=    };

 =9=    my $alias = "_${attribute}_accessor";
 =10=   *{$declaredclass.'::'.$attribute} = $accessor;
 =11=   *{$declaredclass.'::'.$alias}     = $accessor;
 =12= }
=2= 中 $declaredclass 是声明 mk_classdata 的包名,比如 Pere::Ubu->mk_classdata('Suitcase'); 时该变量就为 Pere::Ubu, $attribute 是 Suitcase, 而这里的 $data 是给 =5= 行准备的。
=3= 是声明一个匿名函数,并引用给 $accessor
=4= ref($_[0]) || $_[0] 是为了得到所调用该函数的包名。比如 Pere::Ubu->Suitcase('Red'); 时为 Pere::Ubu; 而 Raygun->Suitcase('Orange'); 时为 Raygun。注意这里的 $_[0] 是调用该匿名函数所传递进来的,所以 $wantclass 是该函数所调用的对象。
=5= 注意这里的 @_ 是调用匿名函数的参数,不是 mk_classdata 的参数。 如果参数大于1,就是是Raygun->Suitcase('Orange'); 而不是 my $suitcase = Raygun->Suitcase;,而且 $wantclass 和 $declaredclass 不同时(Raygun->Suitcase('Orange');时 $declaredclass 是 Pere::Ubu, 而调用的是 Raygun),重新调用 mk_classdata 并把 @_ 传递过去($Raygun->mk_classdata,这里就传递了 $data)
=6= 这句是给 Pere::Ubu->Suitcase('Red'); 准备的。
=7= 这样不管是新建立的(=5=)还是单单读取(=6=)都有值返回。
=10= 这句是最紧要的,就是在声明包的符号表里建立 $attribute 到匿名函数的关系。这样就能使用 Pere::Ubu->Suitcase 了
=9= 和 =11= 是另外在符号表里声明了 _${attribute}_accessor(这里是_Suitcase_accessor)。这个的用途是你在继承包里定义 Suitcase 时又想调用原来的 Suitcase, 这时就可以调用 _Suitcase_accessor(这个其实可以用NEXT模块实现)

希望我讲得够明白。慢慢读懂它,你的 Perl 水平就提高上去了。一起进步。:)
Class::* 模块都用了很多技巧,魔法/magic 一样。



blog comments powered by Disqus