perl重载操作符

2017-04-28 08:28:58来源:CSDN作者:Aggressive_snail人点击

    • 为什么要重载
    • overload Pragma
      • 如何处理重载方法
      • 可重载操作符
    • 代码展示

为什么要重载

重载操作符应用于面向对象的设计对象。
在Perl中,对象是一个引用,通常这个引用表示一个指示对象,除了解引用之外不能做其他额外的事情,比如用引用相加,相减,打印引用等等。
如下是只能解引用的情况下我们只能显示的打印、赋值、相加减。

print $object->as_string;$new_object = $subject->add($object);

而**重载**Perl内置操作符,能实现如下的操作

print $object;$new_object = $subject + $object;

overload Pragma

overload pragma实现操作符重载。需要为它提供操作符及其相关行为的一个键/值列表:

package MyClass;use overload     "+" => /&myadd,                         ### 代码引用    "--" => /&decrement,    "<" => "less_than",                     ### 命名方法    "abs" => sub { return @_ };             ### 匿名子例程

如何处理重载方法

通过overload定义重载列表之后,就要在模块中实现指定的子例程行为。

  • 一个重载的操作符执行操作时,会调用相应的处理方法并提供3个参数
  • 前面两个参数是操作数。第三个参数指示前两个参数是否交换顺序
  • 如果这个操作符只使用一个操作数,那么第二个参数是undef
  • perl中只有一个三元操作符?:,幸运的是这个操作符不能重载,所以以上规则成立。

解释一下上面的粗体字部分,

#####  myadd实现'+',有两个操作数,myadd被调用时会有三个参数sub myadd {    my ($x, $y, $swap) = @_;       ...}

对于二元操作符,比如’+’,只要第一个操作数是某个类的对象,或者当第二个操作数是该类的对象而第一个操作数没有重载行为,就会调用该类指定的重载方法。

$object + 6;  ## 调用$object的重载## $x = $object## $y = 6## $swap = 06 + $object;  ## 调用$object的重载,## $x = $object## $y = 6## $swap = 1

可重载操作符

范畴 操作符
转换 "" 0+ bool
算术 + - * / % ** x . neg
逻辑 !
位操作 & | ~ ^ ! << >>
赋值 += -= *= /= %= **= x= .= <<= >>= ++ --
比较 == < <= > >= != <=> lt le gt ge eq ne cmp
数学 atan2 cos sin exp abs log sqrt
文本 <>
匹配 ~~
解引用 ${} @{} %{} &{} *{}
nomethod fallback

代码展示

这段代码是一个表示复数的模块,实现了复数的加,减,乘,绝对值,自增,自减,构造函数复制等

#!/usr/bin/perlpackage Complex 1.0;use strict;use warnings;use overload    fallback => undef,    nomethod => /&noMethod,    "+" => /&overPlus,    "-" => /&overMinus,    "*" => /&overMultiply,    qw("") => /&asString,    qw(--) => /&decrement,    qw(++) => /&increment,    qw(abs) => /&complexAbs,    qw(=) => /&clone;sub new {    my ($class, $args) = @_;    $class = ref($class) || $class;    my $self = {    'real' => 0,    'imag' => 0,    @_,    };    if($args) {    die "invalid args $args, need an Array ref/n" unless (ref($args) eq ref([]));    die "too much numbers in array/n" if (scalar @$args > 2);    &set_real($self,$$args[0]) if defined $$args[0];    &set_imag($self,$$args[1]) if defined $$args[1];    }    bless $self,$class;}sub set_real {    my $class = shift;    my $real = shift || 0;    die "$real is not a number/n" unless isNumber($real);    $class->{real} = $real;}sub set_imag {    my $class = shift;    my $imag = shift || 0;    die "$imag is not a number/n" unless isNumber($imag);    $class->{imag} = $imag;}sub reSet {    my $class = shift;    my $args = shift;    $class->set_real($$args[0]) if defined $$args[0];    $class->set_imag($$args[1]) if defined $$args[1];}sub clone {    my $class = shift;    my $newComplex = $class->new([],%$class);    return $newComplex;}sub get_real {    my $class = shift;    $class->{real};}sub get_imag {    my $class = shift;    $class->{imag};}sub parts {    my $class = shift;    return (&get_real($class), &get_imag($class));}sub isNumber {    my $number = shift;    $number =~ s/^[-+]//;    return 0 if ref($number);    return 0 unless $number =~ /^[/d/.]+$/;    my @times = ($number =~ /(/.)/g);    return 0 if (scalar @times > 1);    return 0 if ($number =~ /^/.|/.$/);    return 1;}sub asString {    my $x = shift;    my ($R, $I) = $x->parts();    if($I =~ /^-/) {    return ("$R${I}i");    } else {    return ("$R+${I}i");    }}sub overPlus {    my ($x, $y, $swap) = @_;    my ($R, $I) = $x->parts();    if ( ref($y) ) {    $R += $y->get_real;    $I += $y->get_imag;    } else {    $R += $y;    }    my $newComplex = $x->new([$R, $I]);    return $newComplex;}sub overMinus {    my ($x, $y, $swap) = @_;    my $subtractor = $y;    if (!ref($y) ) {    $subtractor = $x->new([$y]);    }    if($swap) {    ($x, $subtractor) = ($subtractor, $x);    }    my ($R, $I) = $x->parts;    $R -= $subtractor->get_real;    $I -= $subtractor->get_imag;    return my $newComplex = $x->new([$R, $I]);    # return $newComplex;}sub overMultiply {    my ($x, $y) = @_;    my $times = $y;    if(!ref($y)) {    $times = $x->new([$y]);    }    my $R = ($x->get_real * $times->get_real) - ($x->get_imag * $times->get_imag);    my $I = ($x->get_real * $times->get_imag) + ($times->get_real * $x->get_imag);    return $x->new([$R,$I]);}sub decrement {    my $x = shift;    $x->set_real( $x->get_real - 1);    return $x;}sub increment {    my $x = shift;    $x->set_real( $x->get_real + 1);    return $x;}sub complexAbs {    my $x = shift;    my ($R, $I) = $x->parts();    return sprintf "%.6f", sqrt($R*$R + $I*$I);}sub noMethod {    print "nomethod: @_/n";}1;

加载该模块后尝试运行,各种美妙自行体会

#!/usr/bin/perluse strict;use warnings;use Complex;my $c = Complex->new([4,90]);my $cl = $c->clone();$c->reSet([2,-3]);$cl->reSet([-4,2]);print "/n/$c is: $c/n";print "/n/$cl is: $cl/n";my $sum =  -$cl;print "($c) + ($cl) = $sum/n";my $mt = $cl*$c;print "$cl * $c = $mt/n";print $mt--, "   $mt<----/n";print $cl++, "   $cl<----/n";my $mm = ++$cl;$mm++;print "cl: $cl    mm: $mm/n";print "/n/n";print abs($mt);

最新文章

123

最新摄影

闪念基因

微信扫一扫

第七城市微信公众平台