Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Basic Objects with Overloaded Operators

by perlmonkey (Hermit)
on Apr 20, 2000 at 00:32 UTC ( #8076=perltutorial: print w/ replies, xml ) Need Help??

As I ventured into the OO world of perl (coming from C++) I thought perl was lacking some of the greatest features of OOP, such as overloaded operators. It was not until recently that I found an article which pointed out that you can indeed overload operators in perl, allowing the abilility to really polish off a complete object. The article was in The Perl Journal, 'Operator Overloading in Perl' (Fall 1999) by Hildo Biersma. Read it for a more in depth review.

The object I wrote here is by no means complete, but it should display the techniques that can be utilized to create robust object modules.

For a fairly simplistic concept I chose to write a Complex number object. Now nobody actually needs this package, since we have Math::Complex, but you can validate my results with the standard package, if you are so inclined.

First the basic object:
package Complex; use Carp; #a '_' prefix on variables is a common way to indicate private # variables. (Note that in Perl nothing is actually private # ... well that is a lie - you can use encapsulation to make # variables private, so if you want really private variables # then go read Damian Conway's "Object Oriented Perl" ). sub _REAL {0} #_REAL is a constant '0' sub _IMAG {1} #_IMAG is a constant '1' sub new { my $class = shift; #get class name ('Complex') my $real = shift; #get first argument my $img = shift; #get second argument my $self = [$real, $img]; #create anon array with arguments bless $self, $class; #bless the array as a Complex object return $self; #return our new object } sub AUTOLOAD { my $sub = $AUTOLOAD; #get global $AUTOLOAD function name my $self = shift; #get the current object my $value = shift; #get an optional parameter $sub =~ s/.*://; #strip off package name #let the system handle 'DESTROY' function calls return if $sub =~ /DESTROY/; #make function call upper case to match our constants my $sub = uc($sub); #call the function (should be 'REAL' or 'IMAG' which will # return 0 or 1 respectively). The eval will trap runtime # errors in case someone calls a function that is not _REAL # or _IMAG. my $position = eval("&_".$sub); #if the position is not a number then they called something # bogus like $obj->print, which would call &_PRINT from the # eval, then $postion would be 'undef' unless( $position =~ /\d/ ) { croak("Subroutine undefined: \"$AUTOLOAD\""); } #if no parameter then they just want the Real or Imag value # returned instead of set. if( not defined $value ) { #return the value associated with the position in the array # that was returned from the eval above. return $self->[$position]; } else { #a value was passed in, so assign it to the position in the # array that was returned from the eval above. This # returns $value also, which is not strictly needed; return $self->[$position] = $value; } }
That is it for a basic object. You can do a lot more, but the fundamentals are all here. The above object is actually a Array reference (in the 'new' function), which is probably not standard. It can just as easily be done with a hash reference. The main reason I choose the array is arrays use about half the memory, and it is easier to enforce 'strict' coding. For more reasons on arrays vs hashes read The Perl Journal article 'Perl Heresies: Building Objects Out of Arrays' (Spring 1999) where Greg Bacon compares and contrasts the use of arrays and hashes as objects. Good article.

Anyway what the above module provides is the following functionality:
use Complex; #create a new object my $x = new Complex; #create a new object with initial values my $y = new Complex(5, -3); $x->Real(3); #set $x's real part to '3' $x->Imag(-5); #set $x's imaginary part to '-5' print $x->Real." ".$y->Imag; #prints '3 -3'
The Real, and the Imag functions are not strictly defined in the Complex package. Perl will first look for the actual function Complex::Real, but if that is not available then it will set $AUTOLOAD to 'Complex::Real' then call the Complex::AUTOLOAD function. Perl will pass AUTOLOAD the same arguments that it would have passed 'Complex::Real' had it existed. So for $x->Real(3), the first argument is '$x', and the second argument is '3'. Our AUTOLOAD function above returns a value if there is not a second argument, otherwise it sets the value.

Now the fun and exciting overloaded operators. To do this we use the overloaded module as follows:
use overload "\"\"" => \&Cmp_string, "+" => \&Cmp_add, "*" => \&Cmp_multiply;
The first one is the "" operator which stringifies the object. The function &Cmp_string will be called in the following lines:
print $x; #prints '3 - 5I' my $str = "$x"; #$str = '3 - 5I'
The second operator is the + or addition operator. The function &Cmp_add will be called in the following lines:
$x = $x + $y; $y = $x + 2; $y = 2 + $x;
Similarly the last operator is in the * or multiplication operator. The function &Cmp_multiply will be called in the following lines:
$y = $x * $x; $y = $x * 2; $y = 2 * $x;
Finally the only thing left to do is to actually implement the overloaded functions. This is my limited implementation:
sub Cmp_string { #get the object my $a = shift; #figure out what sign to put between the real # and imaginary part. I do this so we don't get # something like '3 + -5I', although it fairly # irrelevant my $sign = ($a->Imag > 0) ? " + " : " - "; #return a string that looks like '3 - 5I' return $a->Real.$sign.abs($a->Imag)."I"; } sub Cmp_add { #get the calling object; $a is always the Complex object, it # does not matter if we call '$x + 2' or '2 + $x' or # '$x + $y' ... this $a will always be $x. my $a = shift; #get the second object, either a number or an object my $b = shift; #if $b is not a Complex object do the simple math unless( $b->isa( 'Complex' ) ) { #return a new Complex object after doing the simple # arithmetic return new Complex( $a->Real + $b, $a->Imag ); } #return a new Complex object after doing the 'complex' # arithmetic return new Complex($a->Real+$b->Real, $a->Imag+$b->Imag); } sub Cmp_multiply { #get the calling object; $a is always the Complex object, it # does not matter if we call '$x * 2' or '2 * $x' or # '$x * $y' ... this $a will always be $x. my $a = shift; #get the second object, either a number or an object my $b = shift; unless( $b->isa( 'Complex' ) ) { #return a new Complex object after doing the simple # arithmetic return new Complex( $a->Real * $b, $a->Imag * $b); } #figure out the new real and imaginary parts. Good'ol # FOIL method anybody? my $real = ($a->Real * $b->Real) + ($a->Imag * $b->Imag * -1); my $imag = ($a->Real * $b->Imag) + ($a->Imag * $b->Real); #return a new Complex object after doing the 'complex' # arithmetic return new Complex($real, $imag); }
So that is it. The functions are not too difficult, pretty much standard stuff. However I would not consider these to be very robust. I do not actually do any type checking on the second parameter for the Cmp_add and Cmp_multiply. I just check if is a reference of any kind then go ahead. If somebody passed in HASH reference we should definitely treat that different than a 'Complex' reference.
Update: Per a comment in a subnode I changed the code to now to proper type-checking via the isa routine. I previously was just checking to see if ref($b) =~ /\S/ which is pretty weak.

To put it all together:
package Complex; use Carp; use strict; use vars '$AUTOLOAD'; use overload "\"\"" => \&Cmp_string, "+" => \&Cmp_add, "*" => \&Cmp_multiply; #a '_' prefix on variables is a common way to indicate private # variables. (Note that in Perl nothing is actually private # ... well that is a lie - you can use encapsulation to make # variables private, so if you want really private variables # then go read Damian Conway's "Object Oriented Perl" ). sub _REAL {0} #_REAL is a constant '0' sub _IMAG {1} #_IMAG is a constant '1' sub new { my $class = shift; #get class name ('Complex') my $real = shift; #get first argument my $img = shift; #get second argument my $self = [$real, $img]; #create anon array with arguments bless $self, $class; #bless the array as a Complex object return $self; #return our new object } sub AUTOLOAD { my $sub = $AUTOLOAD; #get global $AUTOLOAD function name my $self = shift; #get the current object my $value = shift; #get an optional parameter $sub =~ s/.*://; #strip off package name #let the system handle 'DESTROY' function calls return if $sub =~ /DESTROY/; #make function call upper case to match our constants my $sub = uc($sub); #call the function (should be 'REAL' or 'IMAG' which will # return 0 or 1 respectively). The eval will trap runtime # errors in case someone calls a function that is not _REAL # or _IMAG. my $position = eval("&_".$sub); #if the position is not a number then they called something # bogus like $obj->print, which would call &_PRINT from the # eval, then $postion would be 'undef' unless( $position =~ /\d/ ) { croak("Subroutine undefined: \"$AUTOLOAD\""); } #if no parameter then they just want the Real or Imag value # returned instead of set. if( not defined $value ) { #return the value associated with the position in the array # that was returned from the eval above. return $self->[$position]; } else { #a value was passed in, so assign it to the position in the # array that was returned from the eval above. This # returns $value also, which is not strictly needed; return $self->[$position] = $value; } } sub Cmp_string { #get the object my $a = shift; #figure out what sign to put between the real # and imaginary part. I do this so we don't get # something like '3 + -5I', although it fairly # irrelevant my $sign = ($a->Imag > 0) ? " + " : " - "; #return a string that looks like '3 - 5I' return $a->Real.$sign.abs($a->Imag)."I"; } sub Cmp_add { #get the calling object; $a is always the Complex object, it # does not matter if we call '$x + 2' or '2 + $x' or # '$x + $y' ... this $a will always be $x. my $a = shift; #get the second object, either a number or an object my $b = shift; #if $b is not a Complex object do the simple math unless( $b->isa( 'Complex' ) ) { #return a new Complex object after doing the simple # arithmetic return new Complex( $a->Real + $b, $a->Imag ); } #return a new Complex object after doing the 'complex' # arithmetic return new Complex($a->Real+$b->Real, $a->Imag+$b->Imag); } sub Cmp_multiply { #get the calling object; $a is always the Complex object, it # does not matter if we call '$x * 2' or '2 * $x' or # '$x * $y' ... this $a will always be $x. my $a = shift; #get the second object, either a number or an object my $b = shift; unless( $b->isa( 'Complex' ) ) { #return a new Complex object after doing the simple # arithmetic return new Complex( $a->Real * $b, $a->Imag * $b); } #figure out the new real and imaginary parts. Good'ol # FOIL method anybody? my $real = ($a->Real * $b->Real) + ($a->Imag * $b->Imag * -1); my $imag = ($a->Real * $b->Imag) + ($a->Imag * $b->Real); #return a new Complex object after doing the 'complex' # arithmetic return new Complex($real, $imag); } #module exit status 1;
Of course for more info you must read:
perldoc overload: for definitions of all the possibilites for
                  overloading operators and other functions.
perldoc perlobj:  For a complete intro to perl objects
Object Oriented Perl By Damian Conway: this books is well written
                                       and has more info than you
                                       will ever need.

Comment on Basic Objects with Overloaded Operators
Select or Download Code
Re: Basic Objects with Overloaded Operators
by Adam (Vicar) on Feb 22, 2001 at 07:40 UTC
    This is a well written article on the wonders of overloading and OO. But I have one complaint:
    unless( ref($b) =~ /\S/ ){}
    Is not a good way to find out if a variable is a reference to a Complex or not. The better way is UNIVERSAL::isa(). Every OO class inherits from UNIVERSAL, and so you can always call $object->isa(), like this:
    unless( $b->isa( 'Complex' ) ){}
    Other then that nit-pick, this is a good tutorial.
      Thanks for the comment! I have included the isa call into
      the root node. I wasn't familiar with isa when I wrote the
      article (many moons ago).
      -perlmonkey
        unless(isa( $b, 'Complex' ) ) is more proper to cover the case when $b is not an object.
Re: Basic Objects with Overloaded Operators
by Anonymous Monk on May 23, 2002 at 14:27 UTC
    This isnt realy OO is it, I mean there are SOME features, but I dont see much in the way of contract enfocement? It seems like OO without all of the nice things in OO.
Re: Basic Objects with Overloaded Operators
by educated_foo (Vicar) on May 23, 2002 at 15:37 UTC
    In playing with overloading in the past, I noticed that you can overload the <> "iteration" operator. However, it's not clear (to me) from the docs just what your function is supposed to do. Has anyone out there ever overloaded this, and if so, what are the rules?

    /s

      The Camel, 3ed. has an example:

      package LuckyDraw; use overload '<>' => sub { my $self = shift; return splice @$self, rand @$self, 1; }; sub new { my class = shift; return bless [@_] -> $self; } 1;
      The book does not discuss the rules, but I'm sure this example breaks some of them. To work with while (<$foo>){}, I think the return value should be true in 'bool' context until the source is exhausted. To cope with my @shuffle=<$deck>; and with slices, a wantarray clause should be there to shuffle and return the whole $deck, leaving $deck empty.

      The rules you observe should only be the ones you need to observe.

      After Compline,
      Zaxo

        2

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perltutorial [id://8076]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (6)
As of 2014-11-22 13:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (123 votes), past polls