Moose (X). Continuation

    Continuing the topic Use Moose; Modern OOP in Perl , I want to talk about some interesting features that Moose and its extensions provide.
    From the topic mentioned above, you can understand that with Moose you do not have to spend time on implementing the object model. But besides the automatic creation of accessors / mutators and constructor, there is still a bunch of all sorts of usefulness and interesting things. And with the help of extensions, it’s generally possible to transform Perl beyond recognition (in a good, of course, way).

    I will give examples of code from my module , which I am trying to rewrite in the style of modern perl.

    Part 1. Moose

    1.1 Changing Inherited Attributes

    Let's start with a simple one. As you may have learned from the topic mentioned above, Moose-based classes can inherit attributes in addition to methods. And they can partially change their [inherited attributes]. Very comfortably. A situation where this may be needed: there is a base class and several inheriting from it. Among the attributes of the base class there are those that are needed by all children, only the default value should be for everyone. You do not have to declare an attribute with all properties in every child (data type, access rights, etc.)

    base class: child:
    has request_type => ( is => 'ro', isa => 'Int', lazy => 1, default => undef, init_arg => undef, );

    has '+request_type' => ( default => 32, ); # сохраняем все свойства кроме default

    1.2 Method Modifiers

    In a way, they look like decorators, although they are not. There are three modifiers: before, after, and around. The first two are executed respectively BEFORE and AFTER the method to which they are applied. About the third it is worth telling a little more. The around modifier takes as an argument the name of the method to which it was applied, and already inside the modifier you yourself must explicitly call it [method]. It turns out what happens inside the modifier, and in the place where you need it. Accordingly, you can do anything both BEFORE the call, and AFTER .

    Application example: (the modifier encrypts a certain request after its creation, if the corresponding options are specified)
    after create_request => sub {
        my $self = shift;

        return unless $self->cipher;

        require Crypt::TripleDES;

        my $ciphered_text = sprintf "Phone%s\n%s",
            unpack('H*', Crypt::TripleDES->new->encrypt3($self->request, $self->ciphering_key));


    1.3 augment + inner

    This feature I especially like.
    Imagine that there is a base class, which is a template of some kind of abstract request to the same abstract service. There is a set of parameters that must be added to each request (for example, login, password, number, etc.). In order not to duplicate this addition in each class, we will put it in the base class, and all child classes will work only with the specific part of the request.

    Immediately code:
    base class: child:
    method create_request() { # здесь создается общая часть запроса
        my $req_node = inner();
        $req_node->appendChild( $self->_create_extra_node($_, $self->$_) ) foreach qw(password serial);
        $req_node->appendChild( $self->_create_simple_node('protocol-version', $self->protocol_version) );
        $req_node->appendChild( $self->_create_simple_node('terminal-id', $self->trm_id) );
        $req_node->appendChild( $self->_create_simple_node('request-type', $self->request_type) );
        my $xml = XML::LibXML::Document->new('1.0', 'utf-8');

    augment create_request => sub { # а здесь только специфическая
        my $self = shift;

        my $xml = $self->_create_simple_node('request');
        $xml->appendChild( $self->_create_extra_node('phone', $self->phone) );


    How it works: in the create_request method (by the way, pay attention to its declaration. About this in the second part) there is a call to the "magic" function inner (). This is the part that can be changed. In the child class, we pass an anonymous sub to the augment modifier. So it will be executed in place of inner () when calling create_request on the instance of the child class.
    At first glance, it seems tricky and useless. Tricky - yes, useless - no. To facilitate understanding, it is worthwhile to draw an analogy with changing inherited attributes: the child inherits the method, but partially retains the parent functionality.
    Just do not abuse this opportunity, because it reduces the "transparency" of the code.

    Part 2. MooseX

    This is where the real fun begins) By the way, just in case, I’ll say that MooseX is the module namespace for Moose extensions.

    2.1 MooseX :: Declare

    The module provides excellent syntactic sugar for Moose-based classes. With it, methods become methods, and classes become classes: Or you can do it like this: A couple more important usefulnesses:
    use MooseX::Declare;

    class Business::Qiwi {
        has trm_id => ( is => 'rw', isa => 'Str', required => 1, );
        has password => ( is => 'rw', isa => 'Str', required => 1, );
        has serial => ( is => 'rw', isa => 'Str', required => 1, );
        method get_balance() {
    # ...

    class Business::Qiwi::Balance extends Business::Qiwi::Request {
    # ...

    1. no more need to do my $self = shift;. An invocant is available in the method automatically (under the name $ self).
    2. classes declared with MooseX :: Declare automatically become immutable. Those. you no longer need to do__PACKAGE__->meta->make_immutable

    2.2 MooseX :: Types

    Creation of new data types (including based on existing ones). Example: Using MooseX :: Types, you can avoid quoting the names of data types:
    use MooseX::Types -declare => [qw(Date EntriesList IdsList TxnsList BillsList)]; # объявляем собственные типы
    use MooseX::Types::Moose qw(Int Str ArrayRef HashRef); # импортируем стандартные типы Moose

    subtype Date => as Str => where { /^\d{2}\.\d{2}\.\d{4}$/ } => message { 'Date must be provided in DD.MM.YYYY format' }; # создаем свой тип на основе стандартного Str

    subtype IdsList => as ArrayRef[Int]; # тоже самое действует для has и прототипов методов

    2.3 MooseX :: Declare + MooseX :: Types

    If you use the two above-mentioned modules, then you can do it like this:
    method create_bill(Num $amount, Str $to, Str $txn, Str $comment, Bool $sms_notify?, Bool $call_notify?, Int $confirm_time?) { # присутствует синтаксис для указания именновых/позиционных/необязательных аргументов
    # ...

    method get_bill_status(BillsList $bill) { # можно использовать собственные типы данных!
    # ...

    2.4 MooseX :: MultiMethods

    Adds the ability to overload methods using the multi keyword. This piece of code from the tests for the module will perfectly say for me (hello, “The Big Bang Theory”): This was a short overview of Moose chips (and its extensions) - the new Perl5 object model. In the bright future, perhaps I will try to talk about roles as a substitute for inheritance. For sim let me take my leave.

    use strict;
    use warnings;
    use Test::More tests => 3;

        package Paper; use Moose;
        package Scissors; use Moose;
        package Rock; use Moose;
        package Lizard; use Moose;
        package Spock; use Moose;

        package Game;
        use Moose;
        use MooseX::MultiMethod;

        multi method play (Paper $x, Rock $y) { 1 }
        multi method play (Paper $x, Spock $y) { 1 }
        multi method play (Scissors $x, Paper $y) { 1 }
        multi method play (Scissors $x, Lizard $y) { 1 }
        multi method play (Rock $x, Scissors $y) { 1 }
        multi method play (Rock $x, Lizard $y) { 1 }
        multi method play (Lizard $x, Paper $y) { 1 }
        multi method play (Lizard $x, Spock $y) { 1 }
        multi method play (Spock $x, Rock $y) { 1 }
        multi method play (Spock $x, Scissors $y) { 1 }
        multi method play (Any $x, Any $y) { 0 }

    my $game = Game->new;
    ok($game->play(Spock->new, Scissors->new), 'Spock smashes Scissors');
    ok(!$game->play(Lizard->new, Rock->new), 'Rock crushes Lizard');
    ok(!$game->play(Spock->new, Paper->new), 'Paper disproves Spock');


    Also popular now: