Changes

On this page I'll list the major changes in the book.

2025.07.01 * added Behind the scenes

Object Oriented Programming - OOP in Perl

When would you need to learn how to write Object Oriented code in Perl?

Case 1.

You can accomplish a lot by using Perl in a procedural way, writing statements, functions, and even moving out some functions to modules. At one point you'll encounter a module that is itself written in the Object Oriented paradigm. In order to use that module you'll need to learn a slightly different syntax. It is still not Object Oriented programming, but it is already using some classes and instances.

As you create more complex projects you might start to feel that you need a better organization of your data and functions. One such solution would be to convert some of your code to Object Oriented Perl.

Case 2.

You get tasked to maintain a project that was already written in Object Oriented Perl and now you need to understand the internal working of the classes.

Vocabulary

OOP or Object Oriented Programming is not the same in every programming language. Each implementation has its own features. However there is a mostly common vocabulary. I wrote "mostly" as even the vocabulary used for various features of OOP might differ among programming languages. Let's see what are the words usually used:

class (The blueprint of a collection of data and actions on that data. In python it is referred to as 'class object')
instance (As in an instance of the class. Sometimes it is called an object. In python it is called an 'instance object'.)
members (the collective name of attributes and methods)
attributes (values, the data, basically internal variables)
methods (actions, basically functions working with the data in the class or the instance. There are both class and instance methods)
accessors (getters and setters, a subset of the methods that will allow the user to read or change the content of attributes)
constructor (A specialized method to create the structure of an instance from a class.)
initializer (A specialized method to fill the initial values of an instance after it was created by the constructor.)
destructor (A method to clean up the mess after we are done using an instance.)
inheritance (A way for a specialized class to reuse features of a more generic class.)
polymorphism (The idea that different classes might have identically named attributes or behaviors that are somehow related.)
encapsulation (It is the concept of hiding the internal parts of a class from the external world.)
singleton (A design pattern to ensure that a class has only one instance.)

WWW::Mechanize, and example using OOP

Before learning how to write our classes, let's take a look at an example of using a Perl module which was written in Object Oriented style.

We are looking at the WWW::Mechanize module that makes it easy to send HTTP requests to web servers. I am quite sure you have encountered many similar modules, but for our purposes this would be a fine example.

This is the full code in a file called demo.pl.

use strict;
use warnings;
use feature 'say';
our $VERSION = '0.01';

use WWW::Mechanize;

my $url = shift @ARGV or die "Usage $0 URL";
# say $WWW::Mechanize::VERSION;


my $mech = WWW::Mechanize->new(autocheck => 0);
my $res = $mech->get($url);
say $res->status_line;
say $mech->status();
say $mech->res->status_line;

say '';

$mech->dump_headers();
say '';

if ($mech->success) {
    print $mech->content;
}

We can use it on the command line by passing a URL as a parameter. httpbin.org is a nice web site that can help us verify if your HTTP client works correctly.

In the first example we send a request that is expected to return a JSON structure describing our request.

The first 3 printed line are the status of the response in 3 different ways.
Then we have some 15 line of text which is the header sent by the server to our client.
Then we can see a JSON structure showing the content the server sent us back. In this particular request the server sends back details about our request. So for example we can see that the the User-Agent field was WWW-Mechanize/2.19 the module we used.

$ perl demo.pl https://httpbin.org/get

200 OK
200
200 OK

Connection: close
Date: Sun, 22 Jun 2025 12:40:45 GMT
Server: gunicorn/19.9.0
Content-Length: 271
Content-Type: application/json
Access-Control-Allow-Credentials: true
Access-Control-Allow-Origin: *
Client-Date: Sun, 22 Jun 2025 12:38:26 GMT
Client-Peer: 34.198.95.5:443
Client-Response-Num: 1
Client-SSL-Cert-Issuer: /C=US/O=Amazon/CN=Amazon RSA 2048 M02
Client-SSL-Cert-Subject: /CN=httpbin.org
Client-SSL-Cipher: ECDHE-RSA-AES128-GCM-SHA256
Client-SSL-Socket-Class: IO::Socket::SSL
Client-SSL-Version: TLSv1_2

{
  "args": {}, 
  "headers": {
    "Accept-Encoding": "gzip", 
    "Host": "httpbin.org", 
    "User-Agent": "WWW-Mechanize/2.19", 
    "X-Amzn-Trace-Id": "Root=1-6857f9cd-788661eb40c56ecd14d4d272"
  }, 
  "origin": "46.120.8.126", 
  "url": "https://httpbin.org/get"
}

In the second example we ask the server to pretend there was an uncaught exception in the server that resulted in a "500 Internal Server Error".

$ perl demo.pl https://httpbin.org/status/500

500 INTERNAL SERVER ERROR
500
500 INTERNAL SERVER ERROR

Connection: close
Date: Sun, 22 Jun 2025 12:41:15 GMT
Server: gunicorn/19.9.0
Content-Length: 0
Content-Type: text/html; charset=utf-8
Access-Control-Allow-Credentials: true
Access-Control-Allow-Origin: *
Client-Date: Sun, 22 Jun 2025 12:38:56 GMT
Client-Peer: 18.209.97.55:443
Client-Response-Num: 1
Client-SSL-Cert-Issuer: /C=US/O=Amazon/CN=Amazon RSA 2048 M02
Client-SSL-Cert-Subject: /CN=httpbin.org
Client-SSL-Cipher: ECDHE-RSA-AES128-GCM-SHA256
Client-SSL-Socket-Class: IO::Socket::SSL
Client-SSL-Version: TLSv1_2

Details of the code

Let's go over the important parts of the code:

We load the module. There is no need to list the function we would like to import as we don't import any functions.

use WWW::Mechanize;

In Perl the thin arrow operator is used for method calls. (In most other languages the dot . is used for that, but in Perl the . was already used by string concatenation and thus a different symbol had to be selected.

In this expression we call the new method of the WWW::Mechanize class. It is the constructor. We pass some parameters to initialize the instance. What this expression returns, what we assign to the $mech variable is an instance (object) of the WWW::Mechanize class.

my $mech = WWW::Mechanize->new(autocheck => 0);

In the next line we call the get method on the instance (object) passing some parameter to it. It returns a different object. Specifically this call returns an instance of the HTTP::Response class. I assume, that internally the get method does some work then calls the constructor of the HTTP::Response class and then returns the created instance.

my $res = $mech->get($url);

The next 3 lines show the status of the request in 3 different ways. Normally you'd use only one of them, but here I wanted to show different ways of using OOP.

In the first line we use the status_line method of the HTTP::Response instance we got back from the get call.
In the second line we use the status method of the original WWW::Mechanize instance. This one only shows the status number, without the text.
Finally we see a chained call. Apparently the res method of the WWW::Mechanize instance returns the same HTTP::Response instance as we got from the get call earlier. We don't need to store it in a variable, we can immediately call its method.

say $res->status_line;
say $mech->status();
say $mech->res->status_line;

Reading the code further we see 3 additional method calls.

That's it for our little demonstration of OOP.

We also have a file called Makefile.PL. It is useful to defined the dependencies of our little project.

use strict;
use warnings;
use ExtUtils::MakeMaker;

WriteMakefile(
	NAME         => 'Demo',
	AUTHOR       => q{Gabor Szabo <szabgab@cpan.org>},
	VERSION_FROM => 'demo.pl',
	ABSTRACT     => 'Demo',
	( $ExtUtils::MakeMaker::VERSION >= 6.3002
		? ( 'LICENSE' => 'perl' )
		: () ),
	PL_FILES  => {},
	PREREQ_PM => {
		'WWW::Mechanize'  => 0,
		'Test::More'      => 1,
	},
	dist  => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
	clean => { FILES    => 'Demo-*' },
);

Use recent version of Perl

Before we go on learning about Object Oriented programming in Perl, let's mention a small improvement you can get when using a relatively recent version of perl.

Starting from version 5.36 that was released on 2022-05-28 we can write

use v5.36;

use 5.036;

and that will already turn on both strict mode and warnings and it will also include all the features that came with that version, including the say function.

So if we can require that our code will run on a perl version 5.36 or later then we can replace these 3 rows:

use strict;
use warnings;
use feature 'say';

with a single use-statement.

Behind the scenes

Now that we saw a common Perl module that is used in an OOP fashion, let's look a little bit behind the scenes for that module.

What is that $mech variable that was returned by the constructor of WWW::Mechanize? We called it an instance or an object, but what is it really?

use v5.36;

use Data::Dumper qw(Dumper);

use WWW::Mechanize;

my $url = shift @ARGV or die "Usage $0 URL";

my $mech = WWW::Mechanize->new(autocheck => 0);
say $mech;
say Dumper $mech;

In order to see this I printed out the content of $mech, first with as a plain print-statement. Well, I used say because it is shorter, but you get the picture.

This is the result I got:

WWW::Mechanize=HASH(0x600fcaf04f60)

The right-hand side of that = sign is probably already familiar to you. It is a Hash reference.

The left-hand side of the = sign indicates that it is somehow connected to the "WWW::Mechanize" module.

We say it is bless-ed into the WWW::Mechanize class, because the connection was made using the bless function. We'll talk about it later.

Once we understand that it is a Hash, we can use the Dumper function imported from the standard Data::Dumper module to see the content.

It is pretty big and there is no point in including all of it here so let me show only the beginning and the end:

$VAR1 = bless( {
                 'links' => undef,
                 'forms' => undef,
                 'strict_forms' => 0,
                 ...
                 'show_progress' => undef,
                 'quiet' => 0,
                 'no_proxy' => [],
                 'proxy' => {},
                 'max_redirect' => 7,
                 'protocols_forbidden' => undef
               }, 'WWW::Mechanize' );

At the beginning you can see the bless keyword I mentioned earlier. At the end you can see "WWW::Mechanize", the name of the module (class). These are the visual indications that this is a bless-ed reference. The part between the curly braces is just one big HASH.

Later we'll see that the keys of this hash are the attributes of the instance and as in any hash they can store any type of value: undef, scalars, and other, complex data-structures.

In most other programming languages you cannot really see the underlying data stored in the instance, but in Perl you can see it and even manipulate it. Don't do that.

A warning

One of the problems I see when teaching new things to programmers is that they (we) get a bit too enthusiastic and they will start to use the new knowledge everywhere.

I am sure you remember when you first learned regular expressions and then you wanted to use it everywhere, including parsing of HTML.

So I'd like to tell you up-front that OOP is not the solution to every problem.

We saw this very clearly when in the mid '90s with the introduction of Java people started to use OOP and specifically inheritance everywhere.

The well known example, though it is entirely possible I made that up, was the representations of household items: cats and dogs. As both cats and dogs are mammals it sounded like a good idea to create a class called "Mammal" and to make the class "Cat" and the class "Dog" both inherit from that class. After all there are a lot of common features between cats and dogs. So instead of implementing almost everything twice we can implement them in the "Mammal" class and then make the specializations in the "Cat" and "Dog" classes.

This was fine. However, the need arose to also represent other things around the house: chairs and tables.

At that point some overly enthusiastic person noticed that all 4 types: chairs, tables, cats, and dogs have legs. So they created a class call "LeggedThings" and made all 4 classes inherit from that.

In the name of code-reuse and DRY they created a totally unmaintainable mess.

Of course one does not need OOP to create an unmaintainable mess, but OOP is also just a tool. One needs to weight various possible solutions and makes sure nothing is overused.

Core Perl OOP

Simple empty constructor

Let's start building a class representing a person.

A person has various "features": name, age, spouse, parents, children.

We'll start our journey by first creating a class called Person that does not have any attributes, just a constructor and step-by-step we'll add attributes and methods.

There are various ways to arrange our code, but I think the most common way is to have a separate file for each class. In Perl a class is basically just a module (aka. package). The standard layout of files in a Perl project is having several folders in the root of the project:

All the modules are in a folder called lib.
All the executables (aka. scripts) are in a folder called script.
All the tests are in a folder called t.

This is how it looks like in this first example:

$ tree
.
├── lib
│   └── Person.pm
├── script
│   └── person.pl
└── t
    └── 01-name.t

In the script/person.pl file we see how we can use the Person class.

use strict;
use warnings;
use Data::Dumper qw(Dumper);

use Person;

my $figure = Person->new;

print $figure, "\n";

print Dumper $figure;

As usual first we set up the strict and warnings pragmata, and/or we might want to set the minimum version of Perl with use 5.036;. If you write private code for yourself or for your corporation where you can require a recent version of Perl then do that. If you write and open source project that many people will want to use in older versions of Perl as well, then you might want to be bit less strict with your expectations.
We also load the Dumper function to be able to look behind the scenes.
Then we load the Person module. The same way we loaded the WWW::Mechanize module in the introduction. In Perl each classes is usually represented as a module so if we want to use the Object oriented terminology, we can say we load the Person class.
In order to create an instance (object) of the Person class we need to call the constructor of the class. In Perl there is no special keyword for the constructor. Any method of the class can be the constructor, but usually people call it new(). Because the .-notation used in many languages is already taken for concatenation, we use the thin-arrow notation -> to call methods on classes. It will return an object which is just a scalar value.
If we print out the object itself, we'll see it is a reference to a HASH, but we will also see it is not just any HASH reference. Somehow its representation includes the 'Person' word.
When we use Dumper function we can see that it is a reference to en empty HASH blessed into the Person class.

$ perl -I lib/ script/person.pl
Person=HASH(0x60b887f71518)
$VAR1 = bless( {}, 'Person' );

In our script we have not specified where perl will find the implementation of the Person module. That's why we added -I lib command line option to perl so it will include the lib folder in the search path.

The class

In the implementation of the Person class, you can see this is just an ordinary module with an ordinary function called new.

package Person;
use strict;
use warnings;

sub new {
    my ($class) = @_;

    my $self = {};

    bless $self, $class;

    return $self;
}


1;

It starts with the package declaration and the safety net of use strict and use warnings. Here too we might replace them with use 5.036 if we can demand a new version of perl.
The interesting part is in the new() function. As you can see it accepts a single parameter and assigns it to the $class variable, but where does the value come from? In the script we saw earlier we have not passed any argument to the new function.
In every case you use the thin-arrow notation to call a method, Perl will take the value on the left hand side (in the case of the script above this is the 'Person' string) and pass it as the first parameter to the function call. So in this case the $class variable will hold the 'Person' string. So $class will contain 'Person'.
Then we create a variable called $self, and assign an empty HASH reference. We could build our object on any other type of reference, but most of the classes in Perl are build using HASH references. Also the name $self for representing the object is totally arbitrary, but a common practice in the Perl world.
The key, turning a this simple reference into an object is the call to the bless() function of Perl. This function will mark the HASH reference to be related to the 'Person' class.
The last statement in the new function just returns the object to the caller.
The file ends with the 1; true value the module has to return in order to make the use/require call happy. Some funny people put there 42; or a string with a quotes from their favorie poem. It does not mater what as long as it is considered true in perl.

The test

use strict;
use warnings;

use Test::More tests => 1;

use Person;

my $p = Person->new;
isa_ok($p, 'Person');

constructor
class
object
instance

Attribute/Member - Accessors: Getter/Setter

attribute
member
getter
setter

Once we have an object we will probably want to have attributes. In order to access the attributes we will want to have getters and setters. In the next example we can see that after creating the Person object and assigning it to the $teacher variable, we call the name() method on the object passing a single value to it. This is how we set the 'name' attribute of the $teacher object. We can call this 'setter'.

The next line, calling the name() method again, this time without any parameter will return the previously assigned value. We can call this 'getter'.

As you can see in this example, the 'setter' and the 'getter' are the same method. They are called with the same arrow-notation as we called the new() constructor.

use strict;
use warnings;

use Person;

my $teacher = Person->new;

$teacher->name('Foo');

print $teacher->name, "\n";

package Person;
use strict;
use warnings;

sub new {
    my ($class) = @_;

    my $self = {};

    bless $self, $class;

    return $self;
}

sub name {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{name} = $value;
    }

    return $self->{name};
}

1;

In the implementation of the setter/getter you can see that it is just a plain Perl function. When it is called using the arrow-notation, Perl will take the value on the left hand side of the arrow (in our case the $teacher object) and pass it as the first parameter to the name() function. That's why the name() function is accepting two parameters. The first is the current object, we assign it to the $self variable. Here too, we could use any name instead of self, and indeed there are people who use other names, such as $me or $this, to represent the current object, but the vast majority of Perl developers use the name $self.

The second parameter is the value to be assigned to the attribute. It is only passed when we would like to set the value.

In the next expression we check the number of parameters. If there are exactly two parameters we take the value and assign it to the appropriate key in the HASH reference. In either case we return the value from the HASH reference.

As you can see attributes of an object are simple entries in the HASH reference representing the object. The key in the hash is the name of the attribute and the respective value in the HASH is the value of the attribute.

Attribute in Constructor

use strict;
use warnings;
use v5.10;

use Person;

my $teacher = Person->new( name => 'Foo' );

say $teacher->name;

package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub name {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{name} = $value;
    }

    return $self->{name};
}

1;

Attribute Type constraint

Checking the value of the attributes.

use strict;
use warnings;
use v5.10;

use Person;

my $student = Person->new( name => 'Foo' );

$student->year(1988);

say $student->year;

$student->year('23 years ago');

package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub name {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{name} = $value;
    }

    return $self->{name};
}

sub year {
    my ($self, $value) = @_;
    if (@_ == 2) {
        die qq{Attribute (year) does not pass the type constraint because: } .
            qq{Validation failed for 'Int' with value "$value"}
            if $value !~ /^\d+$/;
        $self->{year} = $value;
    }

    return $self->{year};
}

1;

Attribute Type class

Checking if the attribute belongs to a certain class.

use strict;
use warnings;
use v5.10;

use Person;
use DateTime;

my $student = Person->new( name => 'Foo' );

$student->birthday( DateTime->new( year => 1988, month => 4, day => 17) );

say $student->birthday;

$student->birthday(1988);

package Person;
use strict;
use warnings;

use Scalar::Util qw(blessed);

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub name {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{name} = $value;
    }

    return $self->{name};
}

sub birthday {
    my ($self, $value) = @_;
    if (@_ == 2) {
       die qq{Attribute (birthday) does not pass the type constraint because:} .
           qq{Validation failed for 'DateTime' with value 1988 at accessor}
            if not blessed $value or not $value->isa('DateTime') ;
        $self->{birthday} = $value;
    }

    return $self->{birthday};
}

1;

Attribute - create your own subtype

subtype

The "sex" field is either "m" or "f".

use strict;
use warnings;
use v5.10;

use Person;

my $student = Person->new( name => 'Foo' );

$student->sex('m');
say $student->sex;

$student->sex('male');

package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub name {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{name} = $value;
    }

    return $self->{name};
}

sub sex {
    my ($self, $value) = @_;
    if (@_ == 2) {
       die qq{Attribute (sex) does not pass the type constraint because:}
            if $value ne 'm' and $value ne 'f' ;
        $self->{sex} = $value;
    }

    return $self->{sex};
}

1;

Attribute - coercion

coercion

Accept both "male" and "female" in addition to "m" and "f", but always keep as "m" or "f".

use strict;
use warnings;
use v5.10;

use Person;

my $student = Person->new( name => 'Foo' );

$student->sex('m');
say $student->sex;

$student->sex('female');
say $student->sex;

$student->sex('other');

package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub name {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{name} = $value;
    }

    return $self->{name};
}

sub sex {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $value = lc substr($value, 0, 1);
        die qq{Attribute (sex) does not pass the type constraint because:}
            if $value ne 'm' and $value ne 'f' ;
        $self->{sex} = $value;
    }

    return $self->{sex};
}

1;

Read only attributes

use strict;
use warnings;
use v5.10;

use Person;

my $student = Person->new( fname => 'Foo', lname => 'Bar' );
say $student->fname; # Foo
say $student->lname; # Bar

$student->lname('Bar-Yosef');
say $student->lname; # Bar-Yosef

$student->fname('Zorg');
say $student->fname; # Foo   (did not change!)

package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub lname {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{lname} = $value;
    }

    return $self->{lname};
}

sub fname {
    my ($self) = @_;

    return $self->{fname};
}


1;

The read-only getter could actually throw an exception when it is used as a setter.

Encapsulation

encapsulation

There is no encapsulation.

use strict;
use warnings;
use v5.10;

use Person;
use Data::Dumper qw(Dumper);

my $student = Person->new( fname => 'Foo', lname => 'Bar' );
say $student->fname; # Foo
say $student->lname; # Bar

$student->lname('Bar-Yosef');
say $student->lname; # Bar-Yosef

$student->{fname} = 'Zorg';
say $student->fname; # Zorg   (changed!)

print Dumper \$student;

# $VAR1 = \bless( {
#                   'lname' => 'Bar-Yosef',
#                   'fname' => 'Zorg'
#                 }, 'Person' );

Method call

package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub lname {
    my ($self, $value) = @_;

    return $self->{lname};
}

sub marry {
    my ($self, $other) = @_;

    return $self->{lname} =     $self->{lname} . '-' . $other->lname;
}


1;

use strict;
use warnings;
use v5.10;

use Person;

my $man   = Person->new( lname => 'Bar' );
my $woman = Person->new( lname => 'Foo' );
say $man->lname;   # Bar
say $woman->lname; # Foo

$woman->marry($man);
say $man->lname;   # Bar
say $woman->lname; # Foo-Bar

Inheritance

inheritance

use strict;
use warnings;
use v5.10;

use Person;
use Employee;
use DateTime;

my $student = Person->new( name => 'Foo' );
say $student->name;     # Foo

my $programmer = Employee->new( name => 'Bar' );
say $programmer->name;  # Bar

package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub name {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{name} = $value;
    }

    return $self->{name};
}

1;

package Employee;
use strict;
use warnings;

# use base 'Person';

use parent 'Person';

# our @ISA = ('Person');

1;

Inheritance

use strict;
use warnings;
use v5.10;

use Person;
use Employee;
use DateTime;

my $programmer = Employee->new( name => 'Bar', employer => 'Amazon' );
say $programmer->name;      # Bar
say $programmer->employer;  # Amazon

my $student = Person->new( name => 'Foo', employer => 'Apple' );
say $student->name;     # Foo
say $student->employer;
# Exception:  Can't locate object method "employer" via package "Person"

package Employee;
use strict;
use warnings;

use parent 'Person';

sub employer {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{employer} = $value;
    }

    return $self->{employer};
}

1;

Inheritance

use strict;
use warnings;
use v5.10;

use Person;
use Employee;
use DateTime;

my $programmer = Employee->new( name => 'Bar', employer => 'Amazon' );
say $programmer->name;      # Bar
say $programmer->employer;  # Amazon

my $student = Person->new( name => 'Foo', employer => 'Apple' );
say $student->name;     # Foo
say $student->employer;
# Exception:  Can't locate object method "employer" via package "Person"

package Employee;
use strict;
use warnings;

use parent 'Person';

sub new {
    my ($class, %args) = @_;

    my $employer = delete $args{employer};

    my $self = $class->SUPER::new(%args);

    $self->{employer} = $employer;

    return $self;
}

sub employer {
    my ($self, $value) = @_;
    if (@_ == 2) {
        $self->{employer} = $value;
    }

    return $self->{employer};
}

1;

Polymorhism

polymorphism

Multiple inheritance

multiple inheritance

use parent 'A', 'B';
use parent qw(A B);

use base 'A', 'B';
use base qw(A B);

our @ISA = ('A', 'B');
our @ISA = qw(A B);

Singleton

singleton

package Conf;
use strict;
use warnings;

my $instance;

sub new {
    my ($class) = @_;
    
    die "Called ->new again" if $instance;

    $instance = {};

    bless $instance, $class;

    # Read the configuration ....

    return $instance;
}

sub instance {
    my ($self) = @_;
    
    die "Called ->instance before calling ->new" if not $instance;

    return $instance;
}


1;

use strict;
use warnings;
use v5.10;

use Conf;

my $c = Conf->new;
say $c;   # Conf=HASH(0x4e7fdc)


my $d = Conf->instance;
say $c;   # Conf=HASH(0x4e7fdc)

my $e = Conf->new;
# Called ->new again at lib/Conf.pm line 10.

use strict;
use warnings;
use v5.10;

use Conf;

my $c = Conf->instance;
# Called ->instance before calling ->new at ...

Destructor

destructor
DESTROY

use strict;
use warnings;
use v5.10;

use Person;

my $first  = Person->new( name => 'Bar' );
say $first->name;  # Bar
{
    my $second = Person->new( name => 'Foo' );
    say $second->name;  # Foo
}   # Foo is dying

# Bar is dying

package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub name {
    my ($self, $value) = @_;

    return $self->{name};
}

DESTROY {
    my ($self) = @_;
    print $self->name, " is dying\n";
}

1;

Operator overloading

overload

use strict;
use warnings;
use v5.10;

use Person;
use GrownUp;

my $kid   = Person->new( fname => 'Foo', lname => 'Bar' );
say "Hello $kid";      # Hello Person=HASH(0x8c54d0)

my $parent = GrownUp->new( fname => 'Foo', lname => 'Bar' );
say "Hello $parent";   # Hello Foo Bar

package Person;
use strict;
use warnings;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    return $self;
}

sub fname {
    my ($self, $value) = @_;

    return $self->{fname};
}

sub lname {
    my ($self, $value) = @_;

    return $self->{lname};
}


1;

package GrownUp;
use strict;
use warnings;

use parent 'Person';

use overload
    '""' => \&stringify;

sub stringify {
    my ($self) = @_;
    return $self->fname . ' ' . $self->lname;
}


1;

Class methods and Instance methods

use strict;
use warnings;
use v5.10;

use Person;

my $first   = Person->new( name => 'Foo' );
say Person->count;   # 1
{
    my $second  = Person->new( name => 'Bar' );
    say Person->count; # 2
}
say Person->count;  # 2

package Person;
use strict;
use warnings;

my $count = 0;

sub new {
    my ($class, %args) = @_;

    my $self = \%args;

    bless $self, $class;

    $count++;

    return $self;
}


sub name {
    my ($self, $value) = @_;

    return $self->{name};
}


sub count {
    return $count;
}

1;

Exercise: OOP

Take the code from the "Read only attributes" examples and change the module so that it will throw an exception is someone tries to set the value.

Once that's ready, change the script that it will catch the exception, display a warning and keep running.

Take a look at the code.pl file in the "Singleton" example. It tells the problem is in the Conf.pm file. This is not true. The problem was actually in the calling script, it was discovered in the Conf.pm module. Change the module so the exception will include the file name and line number in the script.

Take the wedding example and change it so if we call ->marry once we will end up with both names changed to the same combined name.

Take the code where people can get married and for each person in the couple add a way to access the object of the other person. Check (in a destructor) what happens when of the object goes out of scope?

Fix the code in the class-method example, to reduce the counter when the object goes out of scope.

Object Oriented Perl

Point

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/../lib";


use Point;

my $p = Point->new();

$p->set_x( 23 );
$p->set_y( 12 );
print $p->get_x, "\n";
print $p->get_y, "\n";

my $q = Point->new(x => 10, y => 20);

print $q->get_x, "\n";
print $q->get_y, "\n";

package Point;
use strict;
use warnings;

our $VERSION = '0.01';

=head1 NAME

Point - example of a Point

=cut

sub new {
    my ($class, %args) = @_;

#    my $self = {};
#    bless $self, $class;

    my $self = bless {}, $class;

    $self->set_x($args{x});
    $self->set_y($args{y});

    return $self;
}

sub get_x {
    my ($self) = @_;

    return $self->{x};
}

sub set_x {
    my ($self, $value) = @_;

    $self->{x} = $value;

    return;
}


sub get_y {
    my ($self) = @_;

    return $self->{y};
}



sub set_y {
    my ($self, $value) = @_;

    $self->{y} = $value;

    return;
}


1;

Point3d: Subclassing Point

package Point::3D;
use strict;
use warnings;

use base 'Point';

sub new {
	my ($class, %args) = @_;

	my $z = delete $args{z};

	my $self = $class->SUPER::new(%args);

	$self->set_z($z);

	return $self;
}

sub get_z {
	my ($self) = @_;

	return $self->{z};
}

sub set_z {
	my ($self, $value) = @_;

	$self->{z} = $value;

	return;
}

1;

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/../lib";

use Point::3D;


my $point = Point::3D->new(x => 10, y => 20, z => 30);
print $point->isa('Point::3D') ? 'ok' : 'false';
print " isa Point::3D\n";

print $point->isa('Point') ? 'ok' : 'false';
print " isa Point\n";

print $point->get_x, "\n";  # 10
print $point->get_y, "\n";  # 20
print $point->get_z, "\n";  # 30

my $point2 = Point::3D->new(x => 15, y => 25, z => 35);

print $point2->get_x, "\n"; # 15
print $point2->get_y, "\n"; # 25
print $point2->get_z, "\n"; # 35

Exercise: Point::Small

Create a class called Point::Small a subclass of Point that will allow coordinates only between 0 and 100. Create a script point_small.pl that uses the new Point::Small class and checks if it works and fails correctly.

Solution: Point::Small

package Point::Small;
use strict;
use warnings;


use base 'Point';

use Carp qw(croak);

sub set_x {
	my ($self, $value) = @_;

	if (0 <= $value and $value < 100) {
		$self->SUPER::set_x($value);
		return;
	}

	#die "Coordinate x needs to be between 0 and 100. Currently it is '$value'";
	croak "Coordinate x needs to be between 0 and 100. Currently it is '$value'";
}

sub set_y {
	my ($self, $value) = @_;

	if (0 <= $value and $value < 100) {
		$self->SUPER::set_y($value);
		return;
	}

	croak "Coordinate y needs to be between 0 and 100. Currently it is '$value'";
}

AUTOLOAD {
	#Carp::cluck("A");
	our $AUTOLOAD;
	print "AUTO: $AUTOLOAD\n";
}

DESTROY {
}

1;

Line - composition

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/../lib";

use Point;
use Line;

my $point1 = Point->new(x => 10, y => 20);
my $point2 = Point->new(x => 15, y => 25);

my $line = Line->new($point1, $point2);
print $line->isa('Line') ? 'ok' : 'false';
print " - Line\n";

print $line->length, "\n";

package Line;
use strict;
use warnings;

sub new {
    my ($class, @args) = @_;
    my $self = bless {}, $class;

    $self->p1(shift @args);
    $self->p2(shift @args);

    return $self;
}

sub p1 {
    my ($self, $value) = @_;
    if ($value) {
        $self->{p1} = $value;
    }
    return $self->{p1};
}

sub p2 {
    my ($self, $value) = @_;
    if ($value) {
        $self->{p2} = $value;
    }
    return $self->{p2};
}

sub length {
    my ($self) = @_;

    my $x = $self->p1->get_x - $self->p2->get_x;
    my $y = $self->p1->get_y - $self->p2->get_y;

    return sqrt($x**2 + $y**2);
}


1;

Line3D - composition and subclassing

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/../lib";

use Point3D;
use Line3D;

my $point1 = Point3D->new(x => 10, y => 20, z => 30);
my $point2 = Point3D->new(x => 15, y => 25, z => 35);

my $line = Line3D->new($point1, $point2);
print $line->isa('Line3D') ? 'ok' : 'false';
print " - Line3D\n";
print $line->isa('Line') ? 'ok' : 'false';
print " - Line\n";

print $line->length, "\n";

package Line3D;
use strict;
use warnings;

use base 'Line';

sub length {
    my ($self) = @_;

    my $x = $self->p1->get_x - $self->p2->get_x;
    my $y = $self->p1->get_y - $self->p2->get_y;
    my $z = $self->p1->get_z - $self->p2->get_z;

    return sqrt($x**2 + $y**2 + $z**2);
}


1;

Indirect calling

The difference between

X->new
new X

Keyboard shortcuts

OOP - Object Oriented Programming in Perl