取势 明道 优术

作者为 扶 凯 发表

概要

 package Human;

  use Moose;
  use Moose::Util::TypeConstraints;

  subtype 'Sex'
      => as 'Str'
      => where { $_ =~ m{^[mf]$}s };

  has 'sex'    => ( is => 'ro', isa => 'Sex', required => 1 );

  has 'mother' => ( is => 'ro', isa => 'Human' );
  has 'father' => ( is => 'ro', isa => 'Human' );

  use overload '+' => \&_overload_add, fallback => 1;

  sub _overload_add {
      my ( $one, $two ) = @_;

      die('Only male and female humans may create children')
          if ( $one->sex() eq $two->sex() );

      my ( $mother, $father )
          = ( $one->sex eq 'f' ? ( $one, $two ) : ( $two, $one ) );

      my $sex = 'f';
      $sex = 'm' if ( rand() >= 0.5 );

      return Human->new(
          sex    => $sex,
          mother => $mother,
          father => $father,
      );
  }

描述

这个 Moose 的 cookbook 演示怎么样使用操作符重载,子类型,强制转换来模仿人类的生殖系统(其实是基因选择).

介绍

我们这个 Human 的类,使用了用户操作符重载,可以让我们 "add" 二个 Human 一起来生一个child(小孩),这个有个前掉,就是这二个对象必须是不同的性别,记住,我们这讲的是生物的繁殖,并不是谈结婚^-^.

目前状况

对于这个例子,我会更进一步做一些更有趣的事情,添加混合其它基因.我们将添加两个基因控制眼睛的颜色,并使用重载实现父的基因结合来为生物学建模.

什么是运算符重载?

重载并不是 Moose 的特定功能.Perl 中来进行重载是普通的面向对象的概念 .重载让对象可以建立自己的运算符,就象内置的 Perl 中一样,在这使用加法操作符(+)来用在字符串上.
在这个例子中,我们重载了加法运算符,所以可以写出象 $child = $mother + $father 这样的代码.

基因

有许多基因影响眼睛的颜色,在这有两个最重要的 gey 和 bey2.我们将开始为每个基因建一个类.

Human::Gene::bey2

package Human::Gene::bey2;

use Moose;
use Moose::Util::TypeConstraints;

type 'bey2_color' => where { $_ =~ m{^(?:brown|blue)$} };

has 'color' => ( is => 'ro', isa => 'bey2_color' );

 

这个类本身并不重要的,我们有类型约束设置可以用的颜色和颜色的属性.

Human::Gene::gey
package Human::Gene::gey;

use Moose;
use Moose::Util::TypeConstraints;

type 'gey_color' => where { $_ =~ m{^(?:green|blue)$} };

has 'color' => ( is => 'ro', isa => 'gey_color' );

 

这和上面的 Humane::Gene::bey2 类的例子基本上一样.除了 gey 类中的基因可以为不同的颜色.

眼睛的颜色

我们将只能给 Human 类的四个属性(每个基因的两个),但是这是一个有点乱.相反,我们将抽象 genes 成一个容器类,Human::EyeColor.然后,Human 可以有一个单一的 eye_color 属性.

package Human::EyeColor;

use Moose;
use Moose::Util::TypeConstraints;

coerce 'Human::Gene::bey2'
      => from 'Str'
          => via { Human::Gene::bey2->new( color => $_ ) };

coerce 'Human::Gene::gey'
      => from 'Str'
          => via { Human::Gene::gey->new( color => $_ ) };

has [qw( bey2_1 bey2_2 )] =>
      ( is => 'ro', isa => 'Human::Gene::bey2', coerce => 1 );

has [qw( gey_1 gey_2 )] =>
      ( is => 'ro', isa => 'Human::Gene::gey', coerce => 1 );

EyeColor 的类中每种类型的基因有两个.我们还为每个类创建一个强制转换,来操作进入一个新的对象的字符串.请注意,如果它试图强制转换的字符串如“indigo”,因为那不是有效的两种类型的基因中的颜色,所以这时强制转换会失败.
顺便说一句,你可以看到,我们可以定义提供一个数组引用的名称作为第一个参数,让其有几个相同的属性.
我们还需要一种方法来计算一组基因中的实际眼睛的颜色的结果. bey2 的 brown 基因在 blue 和 green 之中是显性的. gey 的 green 基因是比起blue 是 green 更加显性 .

sub color {
      my ($self) = @_;

      return 'brown'
          if ( $self->bey2_1->color() eq 'brown'
          or $self->bey2_2->color() eq 'brown' );

      return 'green'
          if ( $self->gey_1->color() eq 'green'
          or $self->gey_2->color() eq 'green' );

      return 'blue';
  }

 

我们希望能够治疗 Human::EyeColor 对象字符串,所以我们定义一个字符串类重载:

use overload '""' => \&color, fallback => 1;

最后,我们需要为加法定义重载.这样,我们就可以添加两个 Human::EyeColor 的对象给新的一个新的(转基因正确)的眼睛颜色.

use overload '+' => \&_overload_add, fallback => 1;

sub _overload_add {
      my ( $one, $two ) = @_;

      my $one_bey2 = 'bey2_' . _rand2();
      my $two_bey2 = 'bey2_' . _rand2();

      my $one_gey = 'gey_' . _rand2();
      my $two_gey = 'gey_' . _rand2();

      return Human::EyeColor->new(
          bey2_1 => $one->$one_bey2->color(),
          bey2_2 => $two->$two_bey2->color(),
          gey_1  => $one->$one_gey->color(),
          gey_2  => $two->$two_gey->color(),
      );
}

sub _rand2 {
      return 1 + int( rand(2) );
}

 

当两个眼睛的颜色对象相加,_overload_add()方法将通过两个 Human::EyeColor 对象.这些都为“+”运算符的左侧和右侧的操作数.此方法返回一个新的 Human::EyeColor 对象.

添加眼睛的颜色到 Human 中

我们的 Human 的类需要加入短短几行,来纳入我们的新写的 Human::EyeColor 类.

use List::MoreUtils qw( zip );

coerce 'Human::EyeColor'
      => from 'ArrayRef'
      => via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
               return Human::EyeColor->new( zip( @genes, @{$_} ) ); };

has 'eye_color' => (
      is       => 'ro',
      isa      => 'Human::EyeColor',
      coerce   => 1,
      required => 1,
);

 

我们还需要修改_overload_add()在 Human 类打开 eye color 时:

return Human->new(
      sex       => $sex,
      eye_color => ( $one->eye_color() + $two->eye_color() ),
      mother    => $mother,
      father    => $father,
  );

结论

我们使用操作符重载,子类型,强制转换三种技术,提供了一个功能强大的接口.
如果您想了解有关重载的内容,请阅读文档重载方法.

 

 

 

 

 

 

来了就留个评论吧! 1个评论



    ladiu 2011年11月7日 的 08:38

    好像比较强大。