Quick look at some of Perl's OO features, primarily to compare to Python's later. Not covering all of the features.
Support for references introduced in Perl 5, Perl's OO makes heavy use of references. OO introduced in Perl 5.
There is no "class" keyword in Perl 5. Other goofyness in syntax.
Very powerful and flexible OO implementation, but has a "tacked on as afterthought" feel to it. Lots of CPAN modules built to automate or change the OO implementation.
Changes coming in Perl 6 (not just to the OO side).
References: Programming Perl (3rd Ed) Chap 12; text: Object Oriented Perl; man pages: perlboot, perltoot, perltootc.
A class is a package, typically bundled as a module.
Methods are subroutines defined inside that package.
An object is a "blessed" piece of data (typically a hash) that due to the blessing is now associated with that class. Refer to the object through a reference and use that reference to call methods.
Note that data inside object is not private. Traditional to use _ at start of attribute names to encourage users to treat them as private (not enforced).
First arg to constructor is name of package/class that is being built. Use it with bless.
First arg to method is ref to the attribute data, like a "this" pointer.
bless takes two args: reference to data for class and string for name of package (class) the data is being made an object of.
Simple "Point" class to hold x,y coords. No args for constructor, just one method for printing contents.
point1:
#!/usr/local/bin/perl -w
BEGIN { unshift(@INC, "."); }
use Point1;
# instantiate object, pass name of class as first arg
# not used much
$point_a = Point1::new("Point1");
print "point_a: " . $point_a->{X} . ", " .
$point_a->{Y} . "\n";
# instantiate object with arrow notation
# more common
$point_b = Point1->new();
print "point_b: $point_b->{X}, $point_b->{Y}\n";
# invoke a method
print "point_b: " . $point_b->dump() . "\n";
output:
point_a: 0, 0 point_b: 0, 0 point_b: 0, 0
Point1.pm:
package Point1; # this is the Point1 class
# constructor
sub new {
my $class = shift;
# create anon hash, store ref
$point = { X => 0,
Y => 0 };
# "bless" the hash via the ref into class
# with given name
bless $point, $class;
# return reference to blessed hash
return $point;
}
# method
sub dump {
my $self = shift; # get self ref, aka "this"
return($self->{X} . ", " . $self->{Y});
}
1;
point2:
#!/usr/local/bin/perl -w
BEGIN { unshift(@INC, "."); }
use Point2;
$point = Point2->new();
print "point: " . $point->dump() . "\n";
# use accessors
print "point: " . $point->X() . ", " .
$point->Y() . "\n";
# create with default values
$point = Point2->new(7, 8);
print "point: " . $point->dump() . "\n";
# create with some default values
$point = Point2->new(7);
print "point: " . $point->dump() . "\n";
output:
point: 0, 0 point: 0, 0 point: 7, 8 point: 7, 0
Point2.pm:
package Point2;
# constructor
sub new {
my $class = shift;
# create anon hash, bless the ref and return
bless { _X => $_[0] || 0, # default values
_Y => $_[1] || 0,
}, $class;
}
# accessor methods
sub X { $_[0]->{_X}; }
sub Y { $_[0]->{_Y}; }
sub dump {
my $self = shift;
return($self->{_X} . ", " . $self->{_Y});
}
1;
point3:
#!/usr/local/bin/perl -w
BEGIN { unshift(@INC, "."); }
use Point3;
$point = Point3->new();
print "initial: " . $point->dump() . "\n";
$point->X(2);
$point->Y(3);
print "now: " . $point->X() . ", " . $point->Y() . "\n";
output:
initial: 0, 0 now: 2, 3
Point3.pm:
package Point3;
# constructor
sub new {
my $class = shift;
bless { _X => $_[0] || 0,
_Y => $_[1] || 0,
}, $class;
}
# accessor/mutator methods
sub X {
my ($self, $x) = @_;
$self->{_X} = $x if defined($x); # set if given and return
return($self->{_X});
}
sub Y {
my ($self, $y) = @_;
$self->{_Y} = $y if defined($y); # set if given and return
return($self->{_Y});
}
sub dump {
my $self = shift;
return($self->{_X} . ", " . $self->{_Y});
}
1;
point4:
#!/usr/local/bin/perl -w
BEGIN { unshift(@INC, "."); }
use Point4;
$point1 = Point4->new();
$point2 = Point4->new();
$point3 = Point4->new();
# get total
print "now have " . Point4::get_count() . " point objects\n";
# cause one to go away
$point3 = undef;
print "now have " . Point4::get_count() . " point objects\n";
# internal version still available
print "now have " . Point4::_get_count() . " point objects\n";
output:
Name "main::point1" used only once: possible typo at ./point4 line 7. Name "main::point2" used only once: possible typo at ./point4 line 8. now have 3 point objects now have 2 point objects now have 2 point objects
Point4.pm:
package Point4;
# constructor
sub new {
my $class = shift;
$class->_incr_count();
bless { _X => $_[0] || 0,
_Y => $_[1] || 0,
}, $class;
}
# restrict count to this block
{
my $_count = 0;
sub _incr_count { $_count++; }
sub _decr_count { $_count--; }
sub _get_count { $_count; }
}
sub get_count {
_get_count();
}
# destructor
DESTROY {
_decr_count();
}
rest omited
Can use name of method stored in variable:
$methodname = "sum"; $objref->$methodname(1, 2); # calls method "sum"
Use the @ISA array to tell a class it has parents to inherit from. (ISA = "is-a").
If a method is not found, the parents will be searched in order (left to right) for a method, first one found will be invoked. In deep hierarchy will do depth-first search.
Alternative: "use base" to force classes in at compile time instead of run-time. Sometimes needed if module inheriting from is not installed in INC.
Constructors overriding each other cannot pass part of args up to parent, have to shift default-setting to a separate routine which each will invoke and that one will invoke parents'. Requires some funny tricks.
inherit:
#!/usr/local/bin/perl -w
package One;
sub new {
$class = shift;
print "creating object of class $class\n";
bless {}, $class;
}
package Two;
@ISA = ("One");
sub new {
$class = shift;
print "creating object of class $class\n";
bless {}, $class;
}
$one = One->new();
$two = Two->new();
output:
Name "Two::one" used only once: possible typo at ./inherit line 23. Name "Two::two" used only once: possible typo at ./inherit line 24. creating object of class One creating object of class Two
zpoint:
#!/usr/local/bin/perl -w
BEGIN { unshift(@INC, "."); }
use ZPoint;
$point = ZPoint->new();
print "initial: " . $point->dump() . "\n";
$point->X(2);
$point->Y(3);
$point->Z(4);
print "now: " . $point->X() . ", " .
$point->Y() . ", " .
$point->Z() . "\n";
output:
initial: 0, 0, 0 now: 2, 3, 4
ZPoint.pm:
package ZPoint;
use base ("Point3");
# constructor
sub new {
my $class = shift;
bless { _X => $_[0] || 0,
_Y => $_[1] || 0,
_Z => $_[2] || 0,
}, $class;
}
# accessor/mutator methods
sub Z {
my ($self, $z) = @_;
$self->{_Z} = $z if defined($z); # set if given and return
return($self->{_Z});
}
sub dump {
my $self = shift;
return($self->{_X} . ", " . $self->{_Y} . ", " . $self->{_Z});
}
1;
If you use the "use overload" pragma you can overload operators.
Instead of having to say $point3 = $point1->add($point2); you can say $point3 = $point1 + $point2;
overload:
#!/usr/local/bin/perl -w
BEGIN { unshift(@INC, "."); }
use Point5;
$point1 = Point5->new(3, 4);
$point2 = Point5->new(1, 1);
$point3 = $point1 + $point2;
print $point1->dump() . " + " .
$point2->dump() . " = " .
$point3->dump() . "\n";
$point3 = $point1 - $point2;
print $point1->dump() . " - " .
$point2->dump() . " = " .
$point3->dump() . "\n";
output:
3, 4 + 1, 1 = 4, 5 3, 4 - 1, 1 = 2, 3
Point5.pm:
package Point5;
use overload('+' => \&add, # by sub ref
'-' => 'subtract'); # by name
# can also be inline,
# '+' => sub {}
# constructor
sub new {
my $class = shift;
bless { _X => $_[0] || 0,
_Y => $_[1] || 0,
}, $class;
}
sub add {
my($one, $two) = @_;
return bless {_X => $one->{_X} + $two->{_X},
_Y => $one->{_Y} + $two->{_Y}};
}
sub subtract {
my($one, $two) = @_;
return bless {_X => $one->{_X} - $two->{_X},
_Y => $one->{_Y} - $two->{_Y}};
}
1;