在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
本文比较了在 Perl 中两种主流的面向对象编程的实现方式,基于匿名哈希表的实现和基于数组的实现。深刻地剖析了两种实现的技术内幕,并且提供了可供读者直接使用的代码和模块示例。在文章的最后作者比较了两种实现方式的优劣,并对读者给出了在实际工作中选择何种方式实现面向对象编程的建议。 package Person; sub new { my ($name, $age) = @_; my $r_object = { “ name ” => $name, “ age ” => $age } return $r_object; } my $personA = Person->new ( “ Tommy ” , 22 ); my $personB = Person->new ( “ Jerry ” , 30 ); print “ Person A ’ s name: ” . $personA->{name} . “ age: ” . $personA->{age} . ” .\n ” ; print “ Person B ’ s name: ” . $personB->{name} . “ age: ” . $personB->{age} . ” .\n ” ;
但是,现在的这个方案有一个致命的缺点,Perl 的编译器并不知道如何 new 函数所返回的指向匿名哈希表的引用属于哪个类(模块)。这样的话,如果要使用类中的实例方法,只能直接标出方法所属于的类(模块)的名字,并将引用作为方法的第一个参数传递给它,如清单 2 所示。 package Person; … sub change_name { my ($self, $new_name) = @_; $self->{name} = $new_name; } my $object_person = Person->new ( “ Tommy ” , 22); print “ Person ’ s name: ” . $object_person->{name} . “ .\n ” ; Person::change_name ($object_person, “ Tonny ” ); print “ Person ’ s new name: ” . $object_person->{name} . “ .\n ” ;
对于这个问题,Perl 中的 bless 函数提供了一个解决问题的桥梁。 bless 以一个普通的指向数据结构的引用为参数,它将会把那个数据结构(注意:此处不是引用本身)标记为属于某个特定的包,这样就赋予了这个匿名哈希表的引用以多态的能力。同时,我们使用箭头记号来直接调用那些实例方法。见清单 3 。 package Person sub new { my $self = {}; shift; my ($name, $age) = @_; $self->{name} = $name; $self->{age} = $age; bless ($self); return $self; } sub change_name { my $self = shift; my $name = shift; $self->{name} = $name; } my $object_person = Person->new ( “ David ” , 27); print “ Name: “ . $object_person->{name} . “ \n ” ; $object_person->change_name ( “ Tony ” ); print “ Name: “ . $object_person->{name} . “ \n ” ;
Perl 的这种调用相应模块函数的能力被称做为运行时联编。调用 new 方法之后,返回一个匿名哈希表的引用,并且包含相应类的名字。 package Person; … my $person_number = 0; … sub new { … $person_number++; } … sub calculate_person_number { return $person_number; } my $object_personA = Person->new ( “ David ” , 27); my $object_personB = Person::new ( “ Tonny ” , 27); my $person_number = Person::calculate_person_number (); print “ We have ” . $person_number . “ persons in all. \n ” ;
基于匿名散列表的方法中的继承: use Person; package Employee; @ISA = qw (Person); sub new { shift; my ($name, $age, $salary) = @_; my $self = Person->new ($name, $age); $self->{salary} = $salary; bless ($self); return $self; } sub change_salary { my $self = shift; my $new_salary = shift; $self->{salary} = $new_salary; } my $object_employee = Employee->new ( "Tonny", 28, 10000 ); print "Name : " . $object_employee->{name} . ", Age : " . $object_employee->{age} . ", Salary : " . $object_employee->{salary} . ". \n"; $object_employee->change_name ("Tommy"); $object_employee->change_salary (13000); print "Name : " . $object_employee->{name} . ", Age : " . $object_employee->{age} . ", Salary : " . $object_employee->{salary} . ". \n";
当用户调用 Employee 的 change_name 方法和 change_salary 方法时,Perl 解析器会在 Employee 包和 Person 包中搜索,寻找符合的函数供期调用。 package InsideOut; require Exporter; @InsideOut::ISA = qw (Exporter); @InsideOut::EXPORT = qw (define_attributes); sub define_attributes { my $package = caller; @{"${package}::_ATTRIBUTES_"} = @_; my $code = ""; foreach my $attribute ( get_attribute_names($package) ) { @{"${package}::_$attribute"} = (); unless ( $package->can("get_${attribute}") ) { $code = $code . _define_get_accessor ($package, $attribute); } unless ( $package->can("set_${attribute}") ) { $code = $code . _define_set_accessor ($package, $attribute); } } $code .= _define_constructor ($package); eval $code; if ($@) { print $code . "\n"; die "ERROR: Unable to define constructor and accessor for $package \n" ; } }
清单 8 定义了内部函数 _define_get_accessor 和 _define_set_accessor,分别负责自动生成实例属性的存取方法。清单 9 定义了内部函数 _define_constructor,这个函数负责生成继承与 InsideOut 模块的类的构造函数 new () 。例十是一个由 InsideOut 模块自动生成的代码的清单。 sub _define_get_accessor { my ($package, $attribute) = @_; my $code = qq { package $package; sub get_${attribute} { return \$_${attribute}\[\${\$_[0]}] } if ( !defined ( \$_free ) ) { \*_free = \*_$attribute; \$_free = 0; } }; return $code; } sub _define_set_accessor { my ($package, $attribute) = @_; my $code = qq { package $package; sub set_${attribute} { if ( scalar (\@_) > 1 ) { \$_${attribute}\[\${\$_[0]}] = \$_[1]; } } }; return $code; }
清单 9. 自动生成构造函数的代码片断 sub _define_constructor { my $package = shift; my $code = qq { package $package; 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; } }; return $code; }
我们继承 InsideOut 模块并且定义一个名为 People 的对象,如清单 10 所示。看看 InsideOut 模块如何为我们自动生成实例属性访问函数和 People 对象的构造函数 new () 。 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. 自动生成的代码片断 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()。 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 函数 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 号释放回空余列表中去。 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; }
基于数组的方法中的继承 |
请发表评论