perltutorial
perlmonkey
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 <I>The Perl Journal</I>, 'Operator Overloading in Perl'
(Fall 1999) by Hildo Biersma. Read it for a more in depth review.
<BR><BR>
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.
<BR><BR>
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.
<BR><BR>
First the basic object:
<CODE>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;
}
}
</CODE>
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 <I>The Perl Journal</I> 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.
<BR><BR>
Anyway what the above module provides is the following functionality:
<CODE>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'
</CODE>
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.
<BR><BR>
Now the fun and exciting overloaded operators. To do this we use the
overloaded module as follows:
<CODE>use overload
"\"\"" => \&Cmp_string,
"+" => \&Cmp_add,
"*" => \&Cmp_multiply;
</CODE>
The first one is the "" operator which stringifies the object. The
function &Cmp_string will be called in the following lines:
<CODE> print $x; #prints '3 - 5I'
my $str = "$x"; #$str = '3 - 5I'
</CODE>
The second operator is the + or addition operator. The function
&Cmp_add will be called in the following lines:
<CODE> $x = $x + $y;
$y = $x + 2;
$y = 2 + $x;
</CODE>
Similarly the last operator is in the * or multiplication operator.
The function &Cmp_multiply will be called in the following lines:
<CODE> $y = $x * $x;
$y = $x * 2;
$y = 2 * $x;
</CODE>
Finally the only thing left to do is to actually implement the
overloaded functions. This is my limited implementation:
<CODE>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);
}
</CODE>
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.<BR>
<B>Update:</B> 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 <CODE>ref($b) =~ /\S/</CODE> which
is pretty weak.
<BR><BR>
To put it all together:
<CODE>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;
</CODE><PRE>
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
<A HREF="http://www.manning.com/Conway/index.html">Object Oriented Perl</A> By Damian Conway: this books is well written
and has more info than you
will ever need.</PRE>