�ݺ�ߣ

Programació OO en Perl
Curs d'introducció a Perl 2011
Barcelona Perl Mongers
Alex Muntada <alexm@alexm.org>

Moose
El sistema d'objectes de Perl 5
Simple, bàsic, esquelètic, ﬂexible.

Ofereix poca ajuda per a la programació orientada a objectes.

Moose
Moose és un sistema d'objectes complet i
potent
Està construït al damunt del sistema d'objectes de Perl 5.

Pren característiques d'altres llenguatges com Smalltalk, Common Lisp i
Perl 6.

Moose és la millor manera de programar objectes en Perl 5 modern.

Classes
En Perl 5 clàssic una classe és un paquet (o mòdul) de Perl dins un ﬁtxer:
Cat.pm

package Cat;
use Moose;

1;

1 de 11

Classes
En Perl 5 modern és el mateix però amb una sintaxi alternativa que permet
crear un context més específic que el del fitxer.

Això ens interessa en cas que vulguem posar més d'una classe dins el mateix
fitxer.

{
package Cat;
use Moose;
}

Mètodes
use Cat;

my $brad = Cat->new();
my $jack = Cat->new();

Mètodes
use Cat;

Cat->meow();

my $alarm = Cat->new();
$alarm->meow();

Mètodes
{
package Cat;
use Moose;

sub meow
{
my $self = shift;
say "Meow!";

2 de 11

}
}

Atributs
{
package Cat;
use Moose;

has 'name' => (
is => 'ro',
isa => 'Str',
);

has( 'age', is, 'ro' );
has 'diet', is => 'rw';
}

Atributs
use Cat;

my $fat = Cat->new( name => 'Fatty', age => 8, diet => 'Sea Treats' );
say $fat->name(), ' eats ', $fat->diet();

$fat->diet( 'Low Sodium Kitty Lo Mein' );
say $fat->name(), ' now eats ', $fat->diet();

Encapsulament
{
package Cat;
use Moose;

has 'name', is => 'ro', isa => 'Str';
has 'birth_year', is => 'ro', isa => 'Int',
default => sub { (localtime)[5] + 1900 };

3 de 11

Encapsulament
sub age
{
my $self = shift;
my $year = (localtime)[5] + 1900;
return $year - $self->birth_year();
}
}

Polimorfisme
sub show_vital_stats
{
my $object = shift;

say 'My name is ', $object->name();
say 'I am ', $object->age();
say 'I eat ', $object->diet();
}

Polimorfisme
Duck Typing

Si quelcom fa quack() és que és un ànec.

Polimorfisme
# how old is the cat?
my $years = $zeppie->age();

# store the cheese in the warehouse for six months
$cheese->age();

Rols
{

4 de 11

package LivingBeing;
use Moose::Role;

requires qw( name age diet );
}

Rols
{
package Cat;
use Moose;
has 'diet', is => 'rw', isa => 'Str';
has 'birth_year', is => 'ro', isa => 'Int',
default => (localtime)[5] + 1900;

with 'LivingBeing';

sub age { ... }
}

Rols
{
package Cat;
use Moose;


with 'LivingBeing', 'CalculateAge::From::BirthYear';
}

Rols
use Cat;

my $kitten = Cat->new( name => 'Kitty', diet => 'ﬁsh' );

say 'This Cat is alive!'

5 de 11

if $kitten->DOES( 'LivingBeing' );

Herència
{
package LightSource;
use Moose;

has 'candle_power', is => 'ro', isa => 'Int',
default => 1;

has 'enabled', is => 'ro', isa => 'Bool',
default => 0, writer => '_set_enabled';

Herència
sub light
{
my $self = shift;
$self->_set_enabled(1);
}

sub extinguish
{
my $self = shift;
$self->_set_enabled(0);
}
}

Herència
{
package LightSource::SuperCandle;
use Moose;

extends 'LightSource';

has '+candle_power', default => 100;
}

6 de 11

Herència
{
package LightSource::Glowstick;
use Moose;


sub extinguish { }
}

Herència
{
package LightSource::Cranky;
use Carp;
use Moose;


Herència
override light => sub
{
my $self = shift;
Carp::carp( "Can't light a lit light source!" )
if $self->enabled;

super();
};

Herència
override extinguish => sub
{
my $self = shift;
Carp::carp( "Can't extinguish an unlit light source!" )
unless $self->enabled;

7 de 11

super();
};
}

Herència
say 'Looks like a LightSource'
if $sconce->isa( 'LightSource' );

say 'Monkeys do not glow'
unless $chimpy->isa( 'LightSource' );

Moose i OO en Perl 5
my $metaclass = Monkey::Pants->meta();
say 'Monkey::Pants instances have the attributes:';
say $_->name for $metaclass->get_all_attributes;
say 'Monkey::Pants instances support the methods:';
say $_->fully_qualiﬁed_name for $metaclass->get_all_methods;

# You can even see which classes extend a given class
my $metaclass = Monkey->meta();
say 'Monkey is the superclass of:';
say $_ for $metaclass->subclasses;

Referències d'objectes
{
package Player;

sub new
{
my ($class, %attrs) = @_;
return bless %attrs, $class;
}
}

8 de 11

my $joel = Player->new(
number => 10,
position => 'center',
);

my $jerryd = Player->new(
number => 4,
position => 'guard',
);

sub format
{
my $self = shift;
return '#' . $self->{'number'} . ' plays ' . $self->{'position'};
}

sub number { return shift->{'number'} }
sub position { return shift->{'position'} }

Cerca de mètodes i herència
package InjuredPlayer;

use parent qw( Player Hospital::Patient );

use mro 'c3';

AUTOLOAD
{
package Foobar;

sub AUTOLOAD
{
our $AUTOLOAD;

9 de 11

my ($name) = $AUTOLOAD =~ /::(w+)$/;

# pretty-print the arguments
local $" = ', ';
say "In AUTOLOAD(@_) for $name!"
}
}

Sobrecàrrega de mètodes
sub overridden
{
my $self = shift;

return $self->SUPER::overridden( @_ );
}

Reﬂexió
say "$pkg exists" if eval { $pkg->can( 'can' ) };

sub module_loaded
{
ny $modname = shift;
$modname =~ s!::!/!g;

return exists $INC{ $modname . '.pm' };
}

say "$func() exists" if $pkg->can( $func );

Conceptes avançats
Afavoriu la composició abans que l'herència.

Principi de responsabilitat única: una classe no ha de fer més feina
de la que li correpon (Empleat sap d'empleats no de nòmines).

DRY: Don¿t Repeat Yourself.

Principi de substitució de Liskov: accepteu generalitzacions però

10 de 11

sigueu especíﬁcs en el que retorneu.

Subtipus i coercions.

Immutabilitat: proveu a fer els vostres objectes no modiﬁcables.

Gràcies
Preguntes? Dubtes? Comentaris? Idees?

11 de 11

�ݺ�ߣ

Programació orientada a objectes en Perl

More Related Content

Programació orientada a objectes en Perl