In Moose (e sistemi derivati – Mouse) si può fissare un tipo di dato per attributo (isa).
# points deve essere (is a) un Int(ero)
Questo controllo può diventare rognoso se il tipo di attributo è complesso: ad esempio DateTime.
Può capitare di dover inserire nell’attributo un oggetto DateTime che rappresenta una data ed un tempo, ma come posso inserire il dato direttamente senza calcolare l’oggetto (ad esempio in lettura da un file)?
Qui entrano in gioco coerce, subtype, ecc.
has ‘datetime’ => (
isa => ‘My::DateTime’, is => ‘rw’, required => 1,
default => sub { DateTime->now() }
);
Questo attributo deve essere un DateTime (per l’esattezza un My::DateTime, ma questo serve solo per non inquinare i namespace in cui lavora Perl), ma vuole gli vengano passati solo oggetti DateTime.
Nel caso decidessi di passare un numero intero all’attributo datetime (es: $self->datetime(1)) intendendendo unix time l’isa genererebbe un errore; comportamento identico se passassi una stringa come “2004-09-16T23:59:58″.
Grazie alla proprietà coerce è possibile “costringere” un dato in entrata a traformarsi in DateTime anche se parte come qualcosa di diverso.
coerce ‘My::DateTime’
=> from ‘Num’ => via { DateTime->from_epoch( epoch => $_ ) }
=> from ‘Str’ => via {
my ($Y,$M,$D,$h,$m,$s) = uc($_) =~ m/^(\d{4})-(\d{2})-(\d{2})T(;
return DateTime->new( year => $Y, month => $M, day => $D, hour ;
};
has ‘datetime’ => (
isa => ‘My::DateTime’, is => ‘rw’, required => 1,
coerce => 1,
default => sub { DateTime->now() }
);
In questo caso abbiamo definito due trasformazioni: in caso l’input sia un ‘Num’, esegui DateTime->from_epoch( epoch => $_ ); in caso sia una stringa passa il valore attraverso quella regex e ritorna un oggetto DateTime.
La cosa funzionava… poi mi è stato indicato DateTime::Format::ISO8601. Troppo bello.
=> as ‘Object’ => where { $_->isa(‘DateTime’) };
coerce ‘My::DateTime’
=> from ‘Num’ => via { DateTime->from_epoch(epoch => $_) }
=> from ‘Str’ => via { DateTime::Format::ISO8601->parse_datetime($_) };
has ‘datetime’ => (
isa => ‘My::DateTime’, is => ‘rw’, required => 1,
coerce => 1,
default => sub { DateTime->now() }
);
Facile, sintetico… elegante.
Pistolando con LWP e qualche chiamata HTTP, avevo bisogno di rendermi conto che cosa mi stesse passando il server.
Ho trovato estremamente utile a scopo di debugging il metodo headers_as_string proprio della risposta (HTTP::Response) che lo eredita da HTTP::Message.
Direi che è l’equivalente del flag -e di lwp-request.
GET http://www.google.it/
User-Agent: lwp-request/5.827 libwww-perl/6.02
200 OK
Cache-Control: private, max-age=0
Connection: close
Date: Sun, 18 Sep 2011 13:39:47 GMT
Server: gws
Content-Type: text/html; charset=ISO-8859-1
Expires: -1
Client-Date: Sun, 18 Sep 2011 13:39:47 GMT
Client-Peer: 209.85.148.105:80
Client-Response-Num: 1
Set-Cookie: we_have_cookies; expires=Tue, 17-Sep-2013 13:39:47 GMT; path=/; domain=.google.it
Set-Cookie: we_have_a_lot_of_cookies!; expires=Mon, 19-Mar-2012 13:39:47 GMT; path=/; domain=.google.it; HttpOnly
Title: Google
X-XSS-Protection: 1; mode=block
Cool.
Dovendo fare il parsing di un XML ho deciso di cambiare libreria e provare qualcosa di nuovo.
Fino ad ora ho sempre usato XML::LibXML che mette in memoria una mappa dell’XML e poi permette di navigarci dentro (DOM).
XML::Parser è uno stream parser che si basa su Expat: l’idea di Expat è avere un puntatore che scorre lungo lo stream xml e rileva eventi specifici (es: la presenza di un tag di apertura) a cui corrispondono delle funzioni che devono elaborare; a queste callback vengono passati determinati parametri (es: un’istanza del parser expat, l’elemento, gli attributi).
La mia implementazione in Perl era dentro un oggetto:
…
sub read {
my $self = shift;
my $input = $self->filepath;
my $sb = $self->scoreboard;
$parser = XML::Parser->new( Handlers => {
Start => \&handle_start,
End => \&handle_end,
});
$parser->parse($input);
}
sub handle_start {
my ( $parser, $element, %attributes ) = @_;
# fai qualcosa…
}
…
e il mio problema principale era come passare un’istanza del mio oggetto alla funzione di callback in modo da avere gli attributi a disposizione della funzione stessa – nello specifico mi interessava avere $self->scoreboard che doveva essere popolato con gli elementi nell’xml.
Soluzione #1
Nello scope della funzione in cui coesistono sia l’istanza del parser che del mio oggetto (sub read {}) creare una sub anonima e passare il coderef all’opzione Handlers del parser.
my $self = shift;
my $input = $self->filepath;
my $sb = $self->scoreboard;
my $handle_start = sub {
my ( $parser, $element, %attributes ) = @_;
# fai qualcosa…
# qui dentro $self è vivo quindi $sb è raggiungibile
};
$parser = XML::Parser->new( Handlers => {
Start => $handle_start
});
$parser->parse($input);
}
La cosa funziona ed è anche abbastanza chiara per i miei gusti, ma mi piaceva poco l’idea di avere una sub corposa scritta dentro un metodo… preferisco quando le sub anonime sono più brevi.
Soluzione #2 (Subclassing!)
Un’altro sistema può essere subclassare il parser e far sì che abbia a disposizione gli oggetti che mi servono ($sb).
Qui il trucco è subclassare non XML::Parser (che passa una istanza di Expat alla callback) ma XML::Parser::Expat stesso; nella copia locale scrivo due metodi per fare set and get di un attributo che il parser si porterà dietro in ogni sua istanza.
# subclassing
use base XML::Parser::Expat;
# set
sub set_current_object {
my($self, obj) = @_;
$self->{_current_object} = $obj;
}
# get
sub get_current_object {
my($self) = @_;
return $self->{_current_object};
}
1;
#
package Oggetto;
use Local::XML::Parser::Expat;
…
sub read {
my $self = shift;
my $input = $self->filepath;
my $sb = $self->scoreboard;
$parser = Local::XML::Parser::Expat->new( Handlers => {
Start => \&handle_start,
End => \&handle_end,
});
$parser->set_current_object($sb); # set dell’attributo
$parser->parse($input);
}
sub handle_start {
my ( $parser, $element, %attributes ) = @_;
# fai qualcosa…
# e qui dentro è possibile fare
# $parser->get_current_object()
# per ottenere $sb
}
…
Questa è una soluzione che mi piace molto ma richiede di complicare il progetto con un nuovo package che sostanzialmente non fa niente – inoltre richiede di scavalcare XML::Parser e usare direttamente Expat.
Soluzione #3
Un’altra soluzione è simile alla prima, ma con un passaggio in più nella sub anonima per tenere ordinate le cose.
my $self = shift;
my $input = $self->filepath;
my $sb = $self->scoreboard;
$parser = XML::Parser->new( Handlers => {
Start => sub { $self->_handle_start(@_) },
});
$parser->parse($input);
}
sub _handle_start {
my ( $self, $parser, $element, %attributes ) = @_;
# fai qualcosa…
# qui dentro $self è vivo quindi $sb è raggiungibile
}
Questo sistema mi piace abbastanza: ha il vantaggio che la sub anonima è breve e c’è un riferimento chiaro ad un metodo interno all’oggetto.
L’unica cosa che mi piace pochino è il passaggio degli elementi nella sub anonima che a mio avviso è poco evidente, d’altra parte se dentro la sub anonima dovessi esplicitare
Start => sub {
my ($parser, $elem, %attrs) = @_;
$self->_handle_start( $parser, $elem, %attrs);
# oppure la chiamata diretta ad una sub se si preferisce
# _handle_start( $self, $parser, $elem, %attrs);
},
}
perderei la brevità.
Ringraziamenti a larsen, dada, dakkar per il confronto a riguardo.
Smanettando con l’OOP in Perl mi capita di appoggiarmi a Moose/Mouse per una serie di comodità legate al constraint check del tipo, getter/setter automatici, ecc. – non apprezzo particolarmente i framework complicati, ma sicuramente ci sono contesti in cui li trovo comodi.
Avendo creato una classe con un attributo che conteneva un array di altri oggetti, stavo pensando a come gestire eventuali duplicati dei contenuti che non volevo. La situazione era più o meno così:
use Mouse;
use Player;
has ‘players’ => (
isa => ‘ArrayRef[Player]‘,
is => ‘rw’,
default => sub {[]}
);
before ‘add_player’ => sub {
my ($self, $passed_player) = @_;
# wanna check
};
sub add_player {
my ($self, $passed_player) = @_;
push @{$self->players}, $passed_player;
return $self;
}
sub add_players {
my ($self,@wannabe_players) = @_;
$self->add_player($_) for (@wannabe_players);
return $self;
}
#…
Nel before era mia intenzione mettere un check per controllare ed evitare i duplicati (controllo dell’elemento passato rispetto alla lista dei presenti).
La cosa in teoria sarebbe pure possibile, peccato che non ci sia modo di interrompere il flusso – quindi chiamato add_player che fa scattare il before che viene elaborato, non c’è modo di interrompere l’azione intrapresa: unica soluzione che mi era venuta in mente era fare un unshift che seguisse il push in caso di record già presente con un after (poco elegante, ma efficace).
Fatto sta che dopo una breve indagine mi è stato consigliato Set::Object che “This module implements a set of objects, that is, an unordered collection of objects without duplication.”.
La mia classe è diventata molto più snella:
use Mouse;
use Set::Object;
use Player;
has ‘players’ => (
isa => ‘Set::Object’,
is => ‘rw’,
default => sub { Set::Object->new() },
handles => {
add_player => ‘insert’,
add_players => ‘insert’,
}
);
#…
e in più sono agevolato da alcuni metodi di S::O particolarmente utili (come size, insert, e altri) – e infatti delego con handles senza vergogna.
In effetti devo ancora vedere se fa tutto quello che vorrei, ciò nonostante è una chicca.
Accadono cose strane…
my $undef = sub { return undef };
my $test = sub { return; };
diag "test: ", &$test;
diag "undef: ", &$undef;’
# test:
# undef: undef
Intanto diag spamma undef (?), e poi perchè return fa così?
Il punto dovrebbe essere svelato in man perlsub:
If you specify no return value, the subroutine returns an empty list in list context, the undefined value in scalar context, or nothing in void context.
Senza alcun valore specificato e richiamato in contesto lista (diag come print crea un contesto lista) return ritorna una lista vuota, e quindi diag la espande con nessun valore.
Forzandolo a scalare ottengo quel che mi aspetto.
my $undef = sub { return undef };
my $test = sub { return; };
diag "test: ", scalar &$test;
diag "undef: ", &$undef;’
# test: undef
# undef: undef
Nota (oha): Le funzioni anonime andrebbero chiamate così:
Nota2: diag spamma undef perchè a riga 2577 di Test::Builder, nella subroutine _print_comment c’è un semplice…
Partire per le ferie e non aver CPAN a disposizione può essere dannoso per l’equilibrio mentale di un perlista.
Così, su suggerimento di larsen, ho dato un occhio a CPAN::Mini (un articolo di Randal L. Schwartz che spiega il “perché”).
Seguendo le indicazioni della documentazione e scegliendo un mirror, ecco la cmdl:
Mo’ vedremo se funzia tutto a dovere, ma l’accoppiata con local::lib è notevolissima.
Patchare progetti pubblici è un grande aiuto per l’autostima.
Mi sono emozionato.
12:16 < trone> sri: script/app routes show the app's routes.
Could be useful to show also the method (via)
used by the specific route?
13:14 <@marcus> trone: patches welcome?
13:14 <+purl> patches welcome is always true or unless for
search.cpan.org or swahili for "Put up or shut up."
13:56 < trone> marcus: sure.
If it can to be useful, I'll do -
if I understand how.
Just asking if could to be interesting
14:20 <@marcus> trone: it seems useful to me
19:18 < Akron> trone: Nice patch!
19:23 < GitHub140> mojo: master sim * 35fb3fe (1 files in 1 dirs):
Add HTTP methods in script routes output
19:23 < GitHub140> mojo: master Sebastian Riedel * 296458e (1 files
in 1 dirs): Merge pull request #149 from
simotrone/master ...
19:23 < GitHub140> mojo: master commits 10efa91...296458e -
http://bit.ly/mRnh8A
19:26 <@yko> trone++ 19:27 * yko updated and tested
19:55 <@sri> trone++