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.