清单 10. 使用 InsideOut 模块创建自己的对象1
2
3
4
5
6
7
8
9
| package People;
use InsideOut;
@ISA = qw (InsideOut);
define_attributes qw (name age);
$object_people = People->new ( “ name ” => “ Tonny ” ,
“ age ” => 28 );
print “ Name : ” . $object_ people->get_name () . “ , Age : ” .
$object_people->get_age () . “ . \n ” ;
|
清单 11. 自动生成的代码片断1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
| package People;
sub get_name {
return $_name[${$_[0]}]
}
if ( !defined ( $_free ) ) {
*_free = *_name;
$_free = 0;
}
package People;
sub set_name {
if ( scalar (@_) > 1 ) {
$_name[${$_[0]}] = $_[1];
}
}
package People;
sub new {
my $class = shift;
my $id;
if ( defined ($_free[$_free]) ) {
$id = $_free;
$_free = $_free[$_free];
undef $_free[$_id];
} else {
$id = $_free++;
}
my $object = bless \$id, $class;
if ( @_ ) {
$object->set_attributes (@_)
}
$object->initialize();
return $object;
}
|
在清单 10 中，我们定义了两个实例属性，name 和 age 。在 People 类的定义中，函数 define_attributes（）被调用，自动生成了例十一中所显示的构造函数 new（）和实例属性访问函数 set_name（），get_name（）和没有被放在例十一中的 set_age（），get_age（） 。 define_attributes（）函数首先调用内部函数 get_attribute_names（），这个函数将递归操作包的 @ISA 数组中包含的模块和其本身的 _ATTRIBUTES_ 数组，来获取这个类在整个继承链中的所有实例属性的名称并且以一个数组的形式返回。 define_attributes（） 函数将会为每一个实例属性初始化一个数组。在 Perl 中所有模块都隐含地继承了一个被称做为 UNIVERSAL 的内建模块，这个模块将自动为 InsideOut 模块提供 can（函数名）的方法。如果一个类或者它的任何基类包含有 can 中设定的函数名的函数，那么 can 方法将返回一个 true 的值。 define_attributes（）函数将检查继承 InsideOut 模块的类和它的基类中是否已定义了 get_$attribute（）和 set_$attribute（），没有就自动为这个 $attribute 的实例属性生成一个存取方法。这样的设计提供了让用户在自己的类定义模块简单地重载这些存取方法的接口。在此之后，define_attributes（）函数调用了内部函数 _define_constructor（），为用户定义的类生成构造函数 new（）。
在内部函数 _define_constructor（）中，变量 $code 纪录了自动生成的构造函数的代码。在 qq 函数包含的结构内，构造函数 new（）最后的返回实质上就是一个指向属性数组行的索引的引用而已。每次 new（）韩树被调用，我们将在 @_free 数组中找到一个空余行的索引，然后将要返回的那个引用指向的标量置为这个空余行的索引。如果没有空余行的存在，则在属性数组的后面加上一行，用于存储新建实例的实例属性。然后调用内部函数 set_attributes（），为已经分配了存储空间的实例属性按用户输入的数据赋值。最后调用函数 initialize（），这个函数可以在用户类中被改写，用于完成用户自己订制的初始化工作。
其余在 InsideOut 模块中被定义的函数见清单 12 到清单 14，清单 12 中的 get_attribute_names（）函数在上文中已经讨论过了，主要返回一个对象所有的实例属性。
清单 12. get_attribute_names 函数1
2
3
4
5
6
7
8
9
10
11
12
13
| sub get_attribute_names {
my $package = shift;
if ( ref ($package) ) {
$package = ref ($package);
}
my @result = @{"${package}::_ATTRIBUTES_"};
if ( defined ( @{"${package}::ISA"} ) ) {
foreach my $base_package (@{"${package}::ISA"}) {
push ( @result, get_attribute_names ($base_package) );
}
}
return @result;
}
|
清单 13. set_attributes 和 get_attribute 函数1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
| sub set_attributes {
my $object = shift;
my $attribute_name;
if ( ref ($_[0] ) ) {
my ($attribute_name_list, $attribute_value_list) = @_;
my $i = 0;
foreach $attribute_name (@{$attribute_name_list}) {
my $set_method_name = "set_" . $attribute_name;
$object->$set_method_name ($attribute_value_list->[$i++]);
}
} else {
my ($attribute_name, $attribute_value);
while (@_) {
$attribute_name = shift;
$attribute_value = shift;
my $set_method_name = "set_" . $attribute_name;
$object->$set_method_name ($attribute_value);
}
}
}
sub get_attributes {
my $object = shift;
my (@retval);
foreach $attribute_name (@_) {
my $get_method_name = "get_" . $attribute_name;
push ( @retval, $object->$get_method_name() );
}
return @retval;
}
|
清单 14 中定义了析构函数 DESTROY（）和初始化函数 initialize（）。初始化函数 initialize（）不做任何事情，只是对继承 InsideOut 模块的类提供了一个可以重载的方法用于定制用户需要的初始化工作。析构函数 DESTROY（）释放与对象相关的所有属性值，并将在实例属性数组中与该对象相关的行中的所有属性元素标记为 undef 。最后将实例所占用的 id 号释放回空余列表中去。
清单 14. 初始化函数和析构函数1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
| sub initialize {
}
sub DESTROY {
my $object = shift;
my $package = ref ($object);
local *_free = *{"{$package}::_free"};
my $id = $$object;
local (@attributes) = get_attribute_names ($package);
foreach my $attribute (@attributes) {
undef ${"${package}::_$attribute"}[$id];
}
$_free[$id] = $_free;
$_free = $id;
}
基于数组的方法中的继承基于数组的方法中的继承与基于匿名哈希表的方法中的继承完全一样。我们设计的 InsideOut 类中利用 @ISA 数组提供了对继承的支持。
|
|
