ЭЛЕКТРОННАЯ БИБЛИОТЕКА КОАПП |
Сборники Художественной, Технической, Справочной, Английской, Нормативной, Исторической, и др. литературы. |
13.14. Overloading OperatorsProblemYou want to use familiar operators like SolutionUse the use overload ('<=>' => \&threeway_compare); sub threeway_compare { my ($s1, $s2) = @_; uc($s1->{NAME}) cmp uc($s2->{NAME}); } use overload ( '""' => \&stringify ); sub stringify { my $self = shift; return sprintf "%s (%05d)", ucfirst(lc($self->{NAME})), $self->{IDNUM}; } DiscussionWhen you use built-in types, certain operators apply, like This pragma takes a list of operator/function call pairs, such as: package TimeNumber; use overload '+' => \&my_plus, '-' => \&my_minus, '*' => \&my_star, '/' => \&my_slash; Now, those four operators can be used with objects of class TimeNumber, and the listed functions will be called. These functions can do anything you'd like. Here's a simple example of an overload of sub my_plus {
my($left, $right) = @_;
my $answer = $left-> It's a good idea to overload numeric operators only when the objects themselves are mirroring some sort of numeric construct, such as complex or infinite precision numbers, vectors, or matrices. Otherwise the code is too hard to understand, leading users to invalid assumptions. Imagine a class that modelled a country. If you can add one country to another, couldn't you subtract one country from another? As you see, using operator overloading for non-mathematical things rapidly becomes ridiculous. You may compare objects (and, in fact, any reference) using either Two operators frequently overloaded even for a non-numeric class are the comparison and string interpolation operators. Both the <=> and the The string interpolation operator goes by the unlikely name of Read the documentation on the Example: Overloaded StrNum ClassHere's a StrNum class that lets you use strings with numeric operators. Yes, we're about to do something we advised against - that is, use numeric operators on non-numeric entities - but programmers from other backgrounds are always expecting #!/usr/bin/perl # show_strnum - demo operator overloading use StrNum; $x = StrNum("Red"); $y = StrNum("Black"); $z = $x + $y; $r = $z * 3; print "values are $x, $y, $z, and $r\n"; print "$x is ", $x < $y ? "LT" : "GE", " $y\n"; values are Red, Black, RedBlack, and 0 Red is GE Black The class is shown in Example 13.1. Example 13.1: StrNumpackage StrNum; use Exporter (); @ISA = 'Exporter'; @EXPORT = qw(StrNum); # unusual use overload ( '<=>' => \&spaceship, 'cmp' => \&spaceship, '""' => \&stringify, 'bool' => \&boolify, '0+' => \&numify, '+' => \&concat, '*' => \&repeat, ); # constructor sub StrNum { my ($value) = @_; return bless \$value; } sub stringify { ${ $_[0] } } sub numify { ${ $_[0] } } sub boolify { ${ $_[0] } } # providing <=> gives us <, ==, etc. for free. sub spaceship { my ($s1, $s2, $inverted) = @_; return $inverted ? $$s2 cmp $$s1 : $$s1 cmp $$s2; } # this uses stringify sub concat { my ($s1, $s2, $inverted) = @_; return StrNum $inverted ? ($s2 . $s1) : ($s1 . $s2); } # this uses stringify sub repeat { my ($s1, $s2, $inverted) = @_; return StrNum $inverted ? ($s2 x $s1) : ($s1 x $s2); } 1; Example: Overloaded FixNum ClassThis class uses operator overloading to control the number of decimal places in output. It still uses full precision for its operations. A #!/usr/bin/perl # demo_fixnum - show operator overloading use FixNum; FixNum->places(5); $x = FixNum->new(40); $y = FixNum->new(12); print "sum of $x and $y is ", $x + $y, "\n"; print "product of $x and $y is ", $x * $y, "\n"; $z = $x / $y; printf "$z has %d places\n", $z->places; $z->places(2) unless $z->places; print "div of $x by $y is $z\n"; print "square of that is ", $z * $z, "\n"; The class itself is shown in Example 13.2. It only overloads the addition, multiplication, and division operations for math operators. Other operators are the spaceship operator, which handles all comparisons, the string-interpolation operator, and the numeric conversion operator. The string interpolation operator is given a distinctive look for debugging purposes. Example 13.2: FixNumpackage FixNum; use strict; my $PLACES = 0; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $parent = ref($proto) && $proto; my $v = shift; my $self = { VALUE => $v, PLACES => undef, }; if ($parent && defined $parent->{PLACES}) { $self->{PLACES} = $parent->{PLACES}; } elsif ($v =~ /(\.\d*)/) { $self->{PLACES} = length($1) - 1; } else { $self->{PLACES} = 0; } return bless $self, $class; } sub places { my $proto = shift; my $self = ref($proto) && $proto; my $type = ref($proto) || $proto; if (@_) { my $places = shift; ($self ? $self->{PLACES} : $PLACES) = $places; } return $self ? $self->{PLACES} : $PLACES; } sub _max { $_[0] > $_[1] ? $_[0] : $_[1] } use overload '+' => \&add, '*' => \&multiply, '/' => \÷, '<=>' => \&spaceship, '""' => \&as_string, '0+' => \&as_number; sub add { my ($this, $that, $flipped) = @_; my $result = $this->new( $this->{VALUE} + $that->{VALUE} ); $result->places( _max($this->{PLACES}, $that->{PLACES} )); return $result; } sub multiply { my ($this, $that, $flipped) = @_; my $result = $this->new( $this->{VALUE} * $that->{VALUE} ); $result->places( _max($this->{PLACES}, $that->{PLACES} )); return $result; } sub divide { my ($this, $that, $flipped) = @_; my $result = $this->new( $this->{VALUE} / $that->{VALUE} ); $result->places( _max($this->{PLACES}, $that->{PLACES} )); return $result; } sub as_string { my $self = shift; return sprintf("STR%s: %.*f", ref($self), defined($self->{PLACES}) ? $self->{PLACES} : $PLACES, $self->{VALUE}); } sub as_number { my $self = shift; return $self->{VALUE}; } sub spaceship { my ($this, $that, $flipped) = @_; $this->{VALUE} <=> $that->{VALUE}; } 1; See AlsoThe documentation for the standard |