$Class[1] = 'Class::Data::Inheritable';

Category: Modules Keywords: Class::Data::Inheritable

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 一样。