Perl Cd Bookshelf [Electronic resources] نسخه متنی

13.14. Overloading Operators

13.14.1. Problem

You want to use familiar
operators like = = or + on
objects from a class you've written, or you want to define the print
interpolation value for objects.

13.14.2. Solution

Use the use overload pragma.
Here are two of the more commonly overloaded operators:

use overload 
'<=>' => \&threeway_compare;
sub threeway_compare {
my ($s1, $s2) = @_;
return 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};
}

13.14.3. Discussion

When you use built-in types, certain operators apply, like
+ for addition or . for string
concatenation. With the use
overload pragma, you can customize these operators
so they do something special on your own objects.

This pragma takes a list of operator/function call pairs, such as:

package TimeNumber;
use overload         '+' => \&my_plus,
'-' => \&my_minus,
'*' => \&my_star,
'/' => \&my_slash;

Those four operators can now be used with objects of class
TimeNumber, and the listed functions will be called as method
invocations. These functions can do anything you'd like.

Here's a simple example of an overload of + for
use with an object that holds hours, minutes, and seconds. It assumes
that both operands are of a class that has a new
method that can be invoked as an object method, and that the
structure names are as shown:

sub my_plus {
my($left, $right) = @_;
my $answer = $left->new( );
$answer->{SECONDS} = $left->{SECONDS} + $right->{SECONDS};
$answer->{MINUTES} = $left->{MINUTES} + $right->{MINUTES};
$answer->{HOURS}   = $left->{HOURS}   + $right->{HOURS};
if ($answer->{SECONDS} >= 60) {
$answer->{SECONDS} %= 60;
$answer->{MINUTES} ++;
}
if ($answer->{MINUTES} >= 60) {
$answer->{MINUTES} %= 60;
$answer->{HOURS}   ++;
}
return $answer;
}

It's probably best to overload numeric operators only when the
objects themselves are mirroring some sort of inherently numeric
construct, such as complex or infinite precision numbers, vectors, or
matrices. Otherwise, the code becomes hard to understand and might
lead users to invalid assumptions. Imagine a class that modeled a
country. If you can add one country to another, couldn't you subtract
one country from another? Applying overloaded mathematical operators
for non-mathematical objects rapidly becomes ridiculous.

You may compare objects (and, in fact, any reference) using either
= = or eq, but this only tells
you whether the addresses are the same. (Using = =
is about 10 times faster than eq though.) Because
an object is a higher-level notion than a raw machine address, you
often want to define your own notion of what it takes for two of them
to be considered equal.

Two operators frequently overloaded even for a non-numeric class are
the comparison and string interpolation operators. Both the <=>
and the cmp operators can be overloaded, although
the former is more prevalent. Once the spaceship operator <=>
is defined for an object, you can use = =,
!=, <,
<=, >, and
>= as well. This lets objects be collated. If
ordering is not desired, overload only = =.
Similarly, an overloaded cmp is used for
lt, gt, and other string
comparisons if they aren't explicitly overloaded.

The string interpolation operator goes by the unlikely name of
", that is, two double quotes. This operator is
triggered whenever a conversion to a string is called for, such as
within double or back quotes or when passed to the
print function.

Read the documentation on the overload pragma that
comes with Perl or Chapter 13 of Programming
Perl. Perl's operator overloading has some elaborate
features, such as string, numeric, and Boolean conversion methods,
autogeneration of missing methods, and reversing operands if needed,
as in 5 + $a
where $a is an object.

13.14.4. Example: Overloaded StrNum Class

Here'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 + and = = to work on
strings. This is a simple way to demonstrate operator overloading. We
almost certainly wouldn't use this in a time-critical production
program due to performance concerns. It's also an interesting
illustration of using a constructor of the same name as the class,
something that C++ and Python programmers may take some small comfort
in.

#!/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 RedBlackRedBlackRedBlack
Red is GE Black

The class is shown in Example 13-1.

Example 13-1. StrNum

  package StrNum;
use Exporter ( );
@ISA = "Exporter";
@EXPORT = qw(StrNum);  # unusual
use overload        (
'<=>'   => \&spaceship,
"cmp"   => \&spaceship,
'"'    => \&stringify,
"bool"  => \&boolify,
'0+'    => \&nummify,
'+'     => \&concat,
'*'     => \&repeat,
);
# constructor
sub StrNum {
my ($value) = @_;
return bless \$value;
}
sub stringify { ${ $_[0] } }
sub nummify    { ${ $_[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;

13.14.5. Example: Overloaded FixNum Class

This class uses operator
overloading to control the number of decimal places in output. It
still uses full precision for its operations. A
places method can be used on the class or a
particular object to set the number of places of output to the right
of the decimal
point.

#!/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";
sum of STRFixNum: 40 and STRFixNum: 12 is STRFixNum: 52
product of STRFixNum: 40 and STRFixNum: 12 is STRFixNum: 480
STRFixNum: 3 has 0 places
div of STRFixNum: 40 by STRFixNum: 12 is STRFixNum: 3.33
square of that is STRFixNum: 11.11

The class itself is shown in Example 13-2. It
overloads only the addition, multiplication, and division operations
for math operators. Other overloaded 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. FixNum

  package 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,
'/'    => \&divide,
'<=>'  => \&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,
}
sub as_number {
my $self = shift;
return $self->{VALUE};
}
sub spaceship {
my ($this, $that, $flipped) = @_;
$this->{VALUE} <=> $that->{VALUE};
}
1;

13.14.6. See Also

The documentation for the standard overload,
bigint, and bigrat pragmata and
the standard Math::BigInt, Math::BigFloat, and Math::Complex modules;
also Chapters 13, 31, and 32 of Programming
Perl