Recipe 13.14. Overloading Operators (Perl Cookbook)

13.14. Overloading Operators

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.

Solution

Use the use overload pragma. Here are two of the most common and useful operators to overload:

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};
}

When you use built-in types, certain operators apply, like + for addition or . for string catenation. 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;

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 + 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 called 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 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 == or eq, but this only tells you whether the addresses are the same. (Using == is about ten times faster than eq though.) Because an object is a higher-level notion that a raw machine address, you often want to define your own notion of what it takes for two of them to be equal to each other.

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 also use ==, !=, <, <=, >, and >= as well. This lets objects be compared. If ordering is not desired, only overload ==. 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. Perl's operator overloading has some elaborate features, such as string and numeric conversion methods, autogenerating missing methods, and reversing operands if needed, as in 5 + $a where $a is an object.

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 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 0
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+'    => \&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 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 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: 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,
            $self->{VALUE}); 
} 

sub as_number {
    my $self = shift;
    return $self->{VALUE};
} 
    
sub spaceship {
    my ($this, $that, $flipped) = @_;
    $this->{VALUE} <=> $that->{VALUE};
} 


1;