Object-Oriented Perl
## Learning Objectives
- Understand blessing and references
- Create classes with bless
- Use inheritance
- Understand method dispatch
- Introduction to Moose
## Basic Concepts
### What is OOP?
- **Objects**: Instances of classes
- **Classes**: Blueprints for objects
- **Methods**: Functions that operate on objects
- **Properties/Attributes**: Data stored in objects
### Perl OOP Model
```perl
package MyClass;
sub new {
my ($class, %args) = @_;
my $self = bless \%args, $class;
return $self;
}
sub method {
my ($self, @args) = @_;
# Implementation
}
```
## bless Function
### Creating Objects
```perl
package Person;
use strict;
use warnings;
sub new {
my ($class, %args) = @_;
my $self = bless {
name => $args{name} // "Anonymous",
age => $args{age} // 0,
}, $class;
return $self;
}
1;
```
### Using the Object
```perl
use strict;
use warnings;
use Person;
my $person = Person->new(name => "Alice", age => 30);
print $person->{name}; # Direct access (not recommended)
print $person->{age};
```
## Methods
### Instance Methods
```perl
package Person;
use strict;
use warnings;
sub new {
my ($class, %args) = @_;
return bless \%args, $class;
}
sub greet {
my ($self) = @_;
return "Hello, my name is $self->{name}";
}
sub have_birthday {
my ($self) = @_;
$self->{age}++;
return $self->{age};
}
1;
```
```perl
use strict;
use warnings;
use Person;
my $person = Person->new(name => "Alice", age => 30);
print $person->greet(); # "Hello, my name is Alice"
print $person->have_birthday(); # 31
```
### Class Methods
```perl
package Person;
use strict;
use warnings;
sub new {
my ($class, %args) = @_;
return bless \%args, $class;
}
sub create_default {
my ($class) = @_;
return $class->new(name => "Default", age => 0);
}
1;
```
```perl
use strict;
use warnings;
use Person;
my $person = Person->create_default();
```
## Accessors
### Simple Accessor
```perl
package Person;
use strict;
use warnings;
sub new {
my ($class, %args) = @_;
return bless \%args, $class;
}
sub name {
my $self = shift;
if (@_) {
$self->{name} = shift;
}
return $self->{name};
}
sub age {
my $self = shift;
if (@_) {
$self->{age} = shift;
}
return $self->{age};
}
1;
```
### Using Accessors
```perl
use strict;
use warnings;
use Person;
my $person = Person->new(name => "Alice", age => 30);
print $person->name(); # "Alice"
$person->name("Bob");
print $person->name(); # "Bob"
```
## Inheritance
### @ISA and Inheritance
```perl
package Animal;
use strict;
use warnings;
sub new {
my ($class, %args) = @_;
return bless \%args, $class;
}
sub speak {
my ($self) = @_;
print "$self->{name} makes a sound\n";
}
1;
```
```perl
package Dog;
use strict;
use warnings;
use parent 'Animal';
sub speak {
my ($self) = @_;
print "$self->{name} says Woof!\n";
}
1;
```
```perl
use strict;
use warnings;
use Animal;
use Dog;
my $animal = Animal->new(name => "Generic");
my $dog = Dog->new(name => "Buddy");
$animal->speak(); # Generic makes a sound
$dog->speak(); # Buddy says Woof!
```
### Multiple Inheritance
```perl
package MyClass;
use strict;
use warnings;
use parent qw(Parent1 Parent2);
```
### SUPER
```perl
package Dog;
use strict;
use warnings;
use parent 'Animal';
sub speak {
my ($self) = @_;
$self->SUPER::speak(); # Call parent's speak
print "$self->{name} says Woof!\n";
}
1;
```
## ref Function
### Checking References
```perl
use strict;
use warnings;
my $ref = \$scalar;
my $arr_ref = \@array;
my $hash_ref = \%hash;
my $obj = MyClass->new();
print ref($ref); # SCALAR
print ref($arr_ref); # ARRAY
print ref($hash_ref); # HASH
print ref($obj); # MyClass (blessed) or ""
# Check if object
if (blessed($obj)) { # Scalar::Util
print "Object of class ", ref($obj), "\n";
}
```
## Wantarray in Methods
### Context-Aware Methods
```perl
package Stack;
use strict;
use warnings;
sub new {
my ($class) = @_;
return bless [], $class;
}
sub push {
my ($self, @items) = @_;
push @$self, @items;
}
sub pop {
my ($self) = @_;
return pop @$self;
}
sub all {
my ($self) = @_;
if (wantarray) {
return @$self;
}
return scalar @$self;
}
1;
```
```perl
use strict;
use warnings;
use Stack;
my $stack = Stack->new();
$stack->push(1, 2, 3);
my @items = $stack->all(); # List context
my $count = $stack->all(); # Scalar context (3)
```
## Destructors
### DESTROY Method
```perl
package File;
use strict;
use warnings;
sub new {
my ($class, $filename) = @_;
open my $fh, "<", $filename or die "Cannot open: $!";
return bless { fh => $fh, filename => $filename }, $class;
}
sub read_line {
my ($self) = @_;
return <$self->{fh}>;
}
sub DEMOLISH {
my ($self) = @_;
close $self->{fh} if $self->{fh};
print "File $self->{filename} closed\n";
}
1;
```
## Moose (Modern OOP)
### Introduction to Moose
```perl
package Person;
use strict;
use warnings;
use Moose;
has 'name' => (
is => 'rw',
isa => 'Str',
required => 1,
);
has 'age' => (
is => 'rw',
isa => 'Int',
default => 0,
);
sub greet {
my ($self) = @_;
return "Hello, I am $self->name";
}
__PACKAGE__->meta->make_immutable;
1;
```
### Using Moose
```perl
use strict;
use warnings;
use Person;
my $person = Person->new(name => "Alice", age => 30);
print $person->greet();
$person->age(31);
print $person->age;
```
### Moose Types
```perl
package Point;
use strict;
use warnings;
use Moose;
use MooseX::Types::Moose qw(Int Num Str);
has 'x' => (
is => 'rw',
isa => 'Int',
);
has 'y' => (
is => 'rw',
isa => 'Int',
);
sub distance {
my ($self, $other) = @_;
my $dx = $self->x - $other->x;
my $dy = $self->y - $other->y;
return sqrt($dx*$dx + $dy*$dy);
}
__PACKAGE__->meta->make_immutable;
1;
```
## Moo (Lightweight Moose)
### Moo Basics
```perl
package Person;
use strict;
use warnings;
use Moo;
has name => (
is => 'rw',
required => 1,
);
has age => (
is => 'rw',
default => 0,
);
sub greet {
my ($self) = @_;
return "Hello, I am $self->name";
}
1;
```
## Roles (Mixins)
### Basic Roles
```perl
package Printable;
use strict;
use warnings;
use Moose::Role;
requires 'as_string'; # Consuming class must implement
sub print {
my ($self) = @_;
print $self->as_string, "\n";
}
1;
```
### Applying Roles
```perl
package Document;
use strict;
use warnings;
use Moose;
with 'Printable';
has 'content' => (is => 'rw');
sub as_string {
my ($self) = @_;
return $self->content;
}
__PACKAGE__->meta->make_immutable;
1;
```
## blessed and Scalar::Util
### Checking Objects
```perl
use strict;
use warnings;
use Scalar::Util qw(blessed reftype);
my $obj = SomeClass->new();
print blessed($obj); # "SomeClass" or undef
print reftype($obj); # "HASH", "ARRAY", etc.
if (blessed($obj) && $obj->isa('SomeClass')) {
print "It's a SomeClass object\n";
}
```
## Summary
- Classes created with `bless` and package
- `->` operator calls methods on objects
- `@ISA` array for inheritance
- `SUPER::method` calls parent implementation
- `ref` returns package name for blessed refs
- `DESTROY` for cleanup when objects destroyed
- Moose/Moo provide modern OOP features
- Roles provide composition without inheritance
Comments
Comments powered by Giscus
To enable comments, add your Giscus embed code here.
Learn more about Giscus →