Hlavní navigace

Perličky: generátory tříd

Michal Svoboda 30. 4. 2008

Říká se, že pro úspěšné zvládnutí programování v jazyce Perl musí být člověk také dostatečně líný. V případě objektového programování můžeme tuto tezi ještě dvakrát podtrhnout. Dnes si představíme tři moduly, které nám pomohou od neustálého vypisování konstruktorů, accessorů a dalších nutností OOP.

Class::InsideOut

Modul Class::InsideOut je minimalistický generátor tříd typu inside-out. Základní použití je

use strict;
use warnings;

package Zvire;
use Class::InsideOut qw/:all/;

Pomocí tagu :all importujeme do třídy mimo jiné i minimalistický konstruktor new. Tento konstruktor vyřeší registraci atributových hashů pro automatickou dealokaci a naplnění atributů pomocí parametrů zavolané funkce new. Naplní se pouze ty atributy, které existují, zbytek se ignoruje. Samotné atributy definujeme pomocí slov public, readonly a private.

readonly jmeno => my %jmena;

Tímto říkáme, že hash %jmena obsahuje atribut

jmeno a zároveň definujeme implicitní accessor jmeno(). Tento accessor je univerzálního typu get-set, tzn. volání bez argumentu dodá aktuální hodnotu a volání s argumentem hodnotu nastaví. V případě readonly volání s parametrem selže, v případě private se accessory nevytváří. Pomocí private je tedy možné také vytvářet vlastní accessory.

A to je vše, co se týče třídy Zvire. Odvozenou třídu Zvire::Kocka vytvoříme obdobně za použití klasického use base nebo our @ISA = qw/Zvire/.

package Zvire::Kocka;

use Class::InsideOut qw/:all/;
use base qw/Zvire/;

V odvozené třídě Zvire::Pes chceme definovat navíc atribut kocka s tím, že budeme vyžadovat, aby byl tento atribut buď undef, nebo instance třídy Zvire::Kocka. Kontrolu budeme provádět i v konstruktoru, a tudíž nestojíme o implicitní konstruktor. Použijeme tedy tag  :std.

package Zvire::Pes;

use Class::InsideOut qw/:std/;
use Carp qw/croak/;
use base qw/Zvire/;

sub _check_kocka {
    my $kocka = shift;

    # parametr musi byt undef a nebo objekt tridy Zvire::Kocka
    return if not defined $kocka;
    unless ($kocka->isa('Zvire::Kocka')) {
        die "ocekaval se objekt Zvire::Kocka\n";
    }
}

Atribut kocka pak nadefinujeme tak, že při jeho změně je zavolána automaticky naše kontrolní funkce. To uděláme pomocí funkce set_hook. Tato do naší (buď anonymní nebo pojmenované) funkce předá v  $_ to, co by se předalo accessoru. Proměnnou $_ je možné změnit, a v tom případě pak accessor použije tuto pozměněnou hodnotu. My ji měnit nebudeme, pouze zkontrolujeme platnost.

Uvnitř hooku je možné zavolat die. Modul Class::InsideOut za nás chytře převede kontext chyby tak, aby se v hlášce objevilo místo, odkud byl accessor zavolán, a nikoliv hook samotný.

public kocka => my %kocky, {
    # pri zmene atributu je provedena jeho kontrola
    set_hook => sub { _check_kocka($_); }
};

Posledním úkolem je předefinovat konstruktor new tak, aby prováděl kontrolu také. V tomto případě budeme muset kontext případného die vyřešit sami. K vlastní konstrukci je možno použít nejprve konstruktor z modulu Class::InsideOut a poté provést kontrolu již nahraných atributů. Pokud by toto z nějakého důvodu nestačilo, můžeme provést klasicky bless na anonymní skalár, ale ten poté musíme pomocí funkce register zaregistrovat k automatické dealokaci a klonování pro vícevláknové programy.

# inicializace s kontrolou
sub new {
    my $self = Class::InsideOut::new(@_);
    eval {
        # zde je mozno provest nekolik kontrol
        _check_kocka($kocky{id $self});
    };
    croak $@ if $@;
    return $self;
}

Nakonec vyrobíme metodu, která nějakým způsobem využívá atributy objektu. Zde je obvykle možné použít již existující accessory. Pokud bychom se v hashích chtěli hrabat ručně, použijeme obvyklý způsob přes refaddr nebo zkráceně id.

sub pronasleduj {
    my $self = shift;
    print $self->jmeno()
        , defined $self->kocka()
          ? ' pronasleduje kocku/kocoura jmenem '
            . $self->kocka->jmeno()
          : ' nepronasleduje nikoho'
        , ".\n";
}

Demonstrační kód vyrobí dva objekty a použije accessor kocka na objektu třídy Zvire::Pes.

package main;

my $tom = Zvire::Kocka->new(jmeno => 'Tom');
my $spike = Zvire::Pes->new(jmeno => 'Spike', kocka => $tom);

$spike->pronasleduj();
$spike->kocka(undef);
$spike->pronasleduj();

Pokud bychom chtěli dělat vylomeniny, Perl nás potrestá.

$spike->jmeno('ahoj');
jmeno() is read-only at cio.pl line 74

$spike->kocka('ahoj');
kocka() ocekaval se objekt Zvire::Kocka at cio.pl line 74

Nicméně, jak bylo řečeno, implicitní minimalistický konstruktor ignoruje nadbytečné argumenty, což může být vnímáno jako nerobustní.

my $prasopes = Zvire::Pes->new(jmeno => 'Spike', prase => 'kvik');

Milou vlastností této minimalistické verze generátoru tříd je mimo rychlost kompilace i zvládnutí tzv. black-box inheritance, tj. možnost odvodit svou třídu z jakékoliv třídy, třeba i takové, která je implementována „postaru“ klasickými blessovanými hashi.

Object::InsideOut

Navzdory podobnému názvu je tento modul spíše protipólem výše zmíněného Class::InsideOut. Jedná se o zbraněmi nabitého, supertěžkého bojového robota, o čemž svědčí mimo jiné i délka dokumentační stránky, kterou je také vhodné si přečíst. Na druhou stranu, o to kratší je pak náš kód.

use strict;
use warnings;

package Zvire;
{
    use Object::InsideOut;

    # atributy
    my @jmeno   :Field
            :Get(get_jmeno)
            :Arg(Name => 'jmeno', Mandatory => 1);
}

Na rozdíl od klasických tříd typu inside-out se zde používají místo hashů pole, která jsou pro přístup podstatně rychlejší. (V případě explicitní potřeby hashe je možno použít i hash.) Přístup k proměnné v případě pole se pak dělá přes dereferenci objektu, tj. $jmeno[$$self], ale, jako obvykle, ve většině případů je možno použít accessory.

Tag :Field říká, že proměnná bude sloužit jako atribut objektu, tj. obstará se automatická dealokace a tak dále.

Pomocí tagu :Get definujeme automatický accessor pro čtení hodnoty get_jmeno. Pomocí :Set můžeme vyrobit accessor pro zápis. Pomocí :Std(jmeno) zároveň vyrobíme oba. Někdo může chtít accessor typu get-set, v tom případě poslouží :Acc(jmeno). Navíc lze definovat pomocí :lv accessor tak, aby bylo možné jej použít na levé straně přiřazení.

Tag :Arg umožňuje konstruktoru (který je plně v režii Object::InsideOut) naplnit atribut ze svých parametrů. Navíc zde máme lepší kontrolu nad tím, co se použije jako parametr konstruktoru. Atributy označené jako Mandatory musí být vyplněny a neznámé atributy jsou vyhodnoceny jako chyba. Lze také specifikovat výchozí hodnotu pomocí Default a pomocí tagu :InitArgs provést námi dodanou dodatečnou inicializaci.

package Zvire::Kocka;
{
    use Object::InsideOut qw/Zvire/;
}

Odvození třídy se provádí přímo přes Object::InsideOut, tedy nepotřebujeme žádné use base.

package Zvire::Pes;
{
    use Object::InsideOut qw/Zvire/;

    sub _check_kocka {
        my $kocka = shift;

        # parametr musi byt undef a nebo objekt tridy Zvire::Kocka
        return 1 if not defined $kocka;
        return $kocka->isa('Zvire::Kocka');
    }

    my @kocka   :Field
            :Arg(kocka)
            :Type(\&Zvire::Pes::_check_kocka)
            :Std(kocka);

U atributu kocka si necháme opět kontrolovat typ. Pomocí tagu :Type(Zvire::Kocka) bychom mohli požadovat, aby parametr byl instancí této třídy, nicméně tím bychom přišli o možnost undef. Proto použijeme referenci na vlastní kontrolovací funkci. Ta tentokrát nevolá die, ale pouze vrací hodnotu pravda/nepravda. Případné die pak zařídí  Object::InsideOut.

Zbytek kódu se příliš nemění. Použití accessorů tedy zjevně naplňuje svůj smysl, tj. zapouzdření implementace třídy. Kdybychom chtěli být precizní, můžeme nadefinovat accessory jako get-set, v tom případě by se kód neměnil vůbec.

    sub pronasleduj {
        my $self = shift;
        print $self->get_jmeno()
            , defined $self->get_kocka()
              ? ' pronasleduje kocku/kocoura jmenem '
                . $self->get_kocka()->get_jmeno()
              : ' nepronasleduje nikoho'
            , ".\n";
    }
}

package main;

my $tom = Zvire::Kocka->new(jmeno => 'Tom');
my $spike = Zvire::Pes->new(jmeno => 'Spike', kocka => $tom);

$spike->pronasleduj();
$spike->set_kocka(undef);
$spike->pronasleduj();

Moose

Tento modul je postaven na meta-balíku (generátoru generátorů tříd) Class::MOP a svou syntaxí a možnostmi se spíše blíží nadcházející verzi perlu Perl6 (která je mimochodem velmi pěkná, ale o tom se přesvědčíme jindy). Je zde například podpora rolí a delegací. Navíc je možno poměrně bohatým způsobem konfigurovat accessory a vlastnosti třídy vůbec. V dokumentaci k modulu existuje řada příkladů jako  Moose::Cookbook.

use strict;
use warnings;

package Zvire;
use Moose;

has 'jmeno' => (is => 'ro', required => 1);

Konstrukce atributů provádíme pomocí slova has. Atributy pak lze konfigurovat nejen pomocí direktiv Moose, ale také pomocí direktiv meta-balíku  Class::MOP::Attribute.

Odvozené třídy se deklarují pomocí slova extends. S konstruktory si opět nemusíme lámat hlavu.

package Zvire::Kocka;
use Moose;

extends 'Zvire';
package Zvire::Pes;
use Moose;

extends 'Zvire';

has 'kocka' => (
    is => 'rw',
    isa => 'Zvire::Kocka',
    clearer => 'clear_kocka'
);

Atribut kocka lze opět nechat automaticky typově kontrolovat. V tomto případě se můžeme spolehnout na Moose, jelikož pro vymazání atributu použijeme speciální accessor typu clearer. Accessory typu get a set se definují automaticky jako univerzální get-set accessor kocka. Pokud bychom to chtěli jinak, můžeme použít direktivy readerwriter. Lze také definovat metody pro inicializaci hodnot a predikát (test atributu na undef).

Zbytek kódu je opět téměř nepozměněn. Místo accessoru typu set s parametrem undef zde používáme přímo výše zmíněný clearer.

sub pronasleduj {
    my $self = shift;
    print $self->jmeno()
        , defined $self->kocka()
          ? ' pronasleduje kocku/kocoura jmenem '
            . $self->kocka()->jmeno()
          : ' nepronasleduje nikoho'
        , ".\n";
}

package main;

my $tom = Zvire::Kocka->new(jmeno => 'Tom');
my $spike = Zvire::Pes->new(jmeno => 'Spike', kocka => $tom);

$spike->pronasleduj();
$spike->clear_kocka();
$spike->pronasleduj();

Závěr

Představili jsme si ve zkratce tři moduly z mnoha, které více nebo méně automatizují konstrukci tříd. Má-li někdo zkušenost s jiným modulem, může přehled doplnit v diskusi. Jako vždy, před použitím některého modulu je vhodné si přečíst příslušnou dokumentaci. Pro další experimenty je možné všechny tři příklady stáhnout: Class::InsideOut , Object::InsideOut , Moose .

Na závěr malé pozorování, jak robustnost implementace ovlivňuje rychlost překladu a běhu programu.

$ time perl cio.pl
user    0m0.045s

$ time perl oio.pl
user    0m0.140s

$ time perl moose.pl
user    0m0.390s
Našli jste v článku chybu?

30. 4. 2008 11:34

Vzhledem k tomu, že většinou chci mít ty objekty perzistentní, tak používám Class::DBI. Což je něco jako XXX on Rail, akorát to nepužívá tyto *píp* slovíčka.

30. 4. 2008 2:45

U nás sa používa Class::Methodmaker (v2), obdobne vie generovať accessory, konštruktory. Má síce nejaké chybičky, ale keď som sa rozhodoval ktorý generátor pouziť, pri porovnaní s Moose bol oveľa (rádovo) rýchlejší.

Na druhej strane, Moose sa pomerne rýchlo vyvíja...

Lupa.cz: E-shopy: jen sleva už nestačí

E-shopy: jen sleva už nestačí

Podnikatel.cz: Přehledná titulka, průvodci, responzivita

Přehledná titulka, průvodci, responzivita

Vitalia.cz: Jak koupit Mikuláše a nenaletět

Jak koupit Mikuláše a nenaletět

Podnikatel.cz: Platební brány a EET? Stále s otazníkem

Platební brány a EET? Stále s otazníkem

Vitalia.cz: Žloutenka v Brně: Nakaženo bylo 400 lidí

Žloutenka v Brně: Nakaženo bylo 400 lidí

Root.cz: Vypadl Google a rozbilo se toho hodně

Vypadl Google a rozbilo se toho hodně

Lupa.cz: Avast po spojení s AVG propustí 700 lidí

Avast po spojení s AVG propustí 700 lidí

Podnikatel.cz: Víme první výsledky doby odezvy #EET

Víme první výsledky doby odezvy #EET

Podnikatel.cz: Prodává přes internet. Kdy platí zdravotko?

Prodává přes internet. Kdy platí zdravotko?

Měšec.cz: U levneELEKTRO.cz už reklamaci nevyřídíte

U levneELEKTRO.cz už reklamaci nevyřídíte

Podnikatel.cz: Dárky v podnikání. Jak je uplatnit v daních?

Dárky v podnikání. Jak je uplatnit v daních?

Lupa.cz: Propustili je z Avastu, už po nich sahá ESET

Propustili je z Avastu, už po nich sahá ESET

DigiZone.cz: NG natáčí v Praze seriál o Einsteinovi

NG natáčí v Praze seriál o Einsteinovi

DigiZone.cz: Další dva kanály nabídnou HbbTV

Další dva kanály nabídnou HbbTV

Podnikatel.cz: Na poslední chvíli šokuje vyjímkami v EET

Na poslední chvíli šokuje vyjímkami v EET

DigiZone.cz: Sony KD-55XD8005 s Android 6.0

Sony KD-55XD8005 s Android 6.0

Lupa.cz: UX přestává pro firmy být magie

UX přestává pro firmy být magie

Vitalia.cz: Jsou čajové sáčky toxické?

Jsou čajové sáčky toxické?

Lupa.cz: Google měl výpadek, nejel Gmail ani YouTube

Google měl výpadek, nejel Gmail ani YouTube

Měšec.cz: Kdy vám stát dá na stěhování 50 000 Kč?

Kdy vám stát dá na stěhování 50 000 Kč?