Simple Example of Object Oriented programme in Perl

This is the example from the book "Intermediate Perl" and it is the easiest one I could find.

First of all, the final script we want to write is:

use strict;

use horse;

my $tv_horse = horse->named('Mr. Ed');

$tv_horse->set_name("Mister Ed");
$tv_horse->set_color("grey");

print $tv_horse->name, ' is ', $tv_horse->color, "\n";


We can see method invocation, as we have used arrow operator(->). Therefore we can conclude that this script is using APIs from an OO module (A Perl module is a reusable package defined in a library file whose name is the same as the name of the package (with a .pm on the end).). That module is horse.

we can think of above program as written below in non-OO Perl:


    Horse::named(Horse, 'Mr. Ed');
    $tv_horse::set_name($tv_horse, 'Mister Ed');
    $tv_horse::set_color($tv_horse, 'grey');
    $tv_horse::name($tv_horse);

Following is explanation of above program line by line :

use strict;
Good for debugging, it is recommended to use.

 use horse;
This line is to load the module horse, which has APIs(or Methods) defined or inheriting APIs from another module.


my $tv_horse = horse->named('Mr. Ed');
This line creates a new object instance of horse with name 'Mr. Ed'. named can be thought of as an API, although in Perl we call it as a constructor. It'll be explained when we take a look at horse module.

$tv_horse->set_name("Mister Ed");
This line uses API set_name, which, as name says, sets the name for horse object. It is a good practice to use self explanatory names.

$tv_horse->set_color("grey");
This line also explains itself the functionality.

print $tv_horse->name, ' is ', $tv_horse->color, "\n";
This line is using 2 APIs- name and color. But these are somehow different, we'll see that later.


Now the file horse.pm (Module which was loaded in previous program):

package horse;

use animal;

use strict;
use vars qw(@ISA);

our @ISA = qw(animal);

1;

There are no APIs defined in this package. However it is inheriting APIs from another package 'animal':

@ISA = qw(animal);
This line will give error with use strict . So we have to use line:

use vars qw(@ISA);

In a package we should always return 1. 

Now file animal.pm, which contains all APIs:

package animal;

use strict;

sub named
{
    my $class = shift;
    my $name  = shift;
    my $self = {
                 name  => $name,
                 color => $class->default_color
    };
    bless $self, $class;
}

sub default_color { "brown" }

sub set_name
{
    my $self           = shift;
    $self->{name} = shift;
}

sub set_color
{
    my $self            = shift;
    $self->{color} = shift;

}

sub name
{
    my $self = shift;
    ref $self ? $self->{name} : $self;
}

sub color
{
    my $self = shift;
    ref $self ? $self->{color} : $self;
}

1;

if we think of our final script as follows, then it is very simple to write animal.pm:

Horse::named(Horse, 'Mr. Ed');
    $tv_horse::set_name($tv_horse, 'Mister Ed');
    $tv_horse::set_color($tv_horse, 'grey');
    $tv_horse::name($tv_horse);