Cet article est la seconde partie d’une série consacrée à Moose qui vise à montrer comment écrire du Perl Objet moderne. Les exemples de code sont tous testés avec l’excellent shell Devel::REPL.

Dans notre précédent article, nous avons vu comment créer une classe “Heros” et nous avons joué avec Conan et lui attribuant un nom et en le torturant un peu. Nous allons voir dans cet article comment le spécialiser en “Barbare” afin de lui donner plus de relief.

Nous voulons que la classe “Barbare” soit une spécialisation de la classe “Heros” et qu’elle présente les particularités suivantes :

• un Barbare peut posséder une armure
• un Barbare pousse un crie de guerre à chaque attaque

Mais avant tout, il nous faut dire ce qu’est un Barbare, il s’agit d’un Heros :

package Barbare;

use Moose;
extends (qw(Heros));

Le mot-clef extends est exporté par Moose dans notre espace de noms, il permet de déclarer l’héritage d’une classe envers une autre. Ici, vous l’avez compris, “Barbare” hérite de “Heros”. Vérifions de suite que l’héritage a bien eu lieu:

Perl> my $conan = new Barbare name => 'Conan';
$Barbare1 = Barbare=HASH(0x8acb7b0);
Perl> $conan->name
Conan
Perl> $conan->pv
20
Perl>

Nous avons bien les attributs d’un Héros, tout va bien.

Nous voulons qu’un barbare puisse posséder une armure, et ainsi amortir encore davantage les coups qu’il reçoie. Cela se fera en deux étapes : ajouter l’attribut “armure” pour stocker la valeur de ladite protection, et subtilement altérer le comportement de la méthode blessure() héritée de la classe Heros.

has 'armure' => (
    is => 'rw',
    isa => 'Int',
    default => 0
);

Rien de bien compliqué ici, un nouvel attribut. Maintenant, la partie intéressante :

around 'blessure' => sub {
    my $orig = shift;
    my ($self, $degats) = @_;
    if ($self->armure) {
        $degats = $degats - $self->armure;
        $degats = 0 if $degats < 0;
    }
    $self->$orig($degats);
};

Le mot-clef “around” nous permet d’envelopper l’appel d’une méthode (ici “blessure”) afin d’en modifier le comportement pour la classe que nous décrivons. Nous définissons donc une méthode ( => sub {} ) qui reçoit en argument respectivement : la référence vers la méthode originelle ($orig), la référence de l’instance en cours ($self) puis les arguments passés lors de l’appel ($degats). Il nous convient ensuite de faire ce que bon nous semble avec cela.

On constate que la dernière instruction de notre encapsulation est l’appel de la méthode originelle (celle de Heros donc) :
$self->$orig($degats);. Si nous enlevons cette ligne, l’appel de la méthode originelle n’aura tout simplement pas lieu.

Nous avons juste pris soin de modifier $degats dans notre encapsulation, et voilà. Si le barbare dispose d’une armure (if ($self->armure)) les dégâts sont amortis d’autant. Testons cela :

Perl> $conan->pv
20
Perl> $conan->blessure(4)
19
Perl> $conan->armure(1)
1
Perl> $conan->blessure(4)
19

Avec son endurance de 3 et son armure de 1, Conan amortit maintenant totalement les blessures de 4 ! Mais quel homme ce Conan !

Nous allons maintenant doter Conan de cris de guerre, en commençant par l’attribut “cris” qui sera d’un nouveau type : ‘ArrayRef’ :

has 'cris' => (
    is => 'rw',
    isa => 'ArrayRef',
    default => sub {[qw(Yeeeeaaa! Ourgh! Mabangaaa!)]},
);

La seule particularité ici est l’encapsulation de la liste dans une fonction, cela est nécessaire pour le bon fonctionnement des accesseurs.
Maintenant que les cris sont définis (et le barbare pourra en apprendre de nouveaux, car nous déclarons l’attribut en read/write), il nous faut une méthode pour crier :

sub crie
{
    my ($self) = @_;
    return $self->cris->[int(rand(@{$self->cris}))];
}

Voyons-voir si cela se comporte comme prévu :

Perl> $conan->cris
$ARRAY1 = [
            'Yeeeeaaa!',
            'Ourgh!',
            'Mabangaaa!'
          ];
Perl> $conan->crie
Mabangaaa!
Perl> $conan->crie
Ourgh!
Perl>

Il nous reste à venir intercepter l’appel à la méthode “attaque” pour pousser un cri avant que celle-ci s’éxecute ; cela se fera au moyen d’une structure similaire à celle vue ci-dessus avec ‘around’ mais avec un autre corchet : “before” (on dispose évidemment de son pendant “after” également) :

before 'attaque' => sub {
    my ($self) = @_;
    print $self->crie."\n";
};

Maintenant, vérifions que Conan pousse la chansonette à chaque attaque :

Perl> $conan->attaque
Mabangaaa!
11
Perl> $conan->attaque
Ourgh!
12

Conan est désormais un barbare digne de ce nom, et il peut snober les petits héros de pacotille si communs lorsqu’il les croise dans une taverne. Sacré Conan.

Dans notre article suivant, nous utiliserons Moose::Role afin d’ajouter une arme à notre classe Heros. Conan poura donc brandir un glaive, sacré Conan !