Moose es un completo sistema de objetos para
Perl 5. Defines tu clase en forma declarativa. Está basado en gran parte en el sistema de objetos de Perl 6 tomando las mejores ideas de CLOS, Smalltalk y otros lenguajes.
Crearemos la clase Transporte. Un Colectivo es un medio de Transporte. Entonces en el archivo Colectivo.pm escribimos la clase Colectivo que tiene un número de línea y un color:
package Colectivo;
use Moose;
has 'nombre' => (is => 'rw');
has 'color' => (is => 'rw');
1;
Aquí decimos que Colectivo tiene nombre y color, y que son atributos de lectura/escritura. Podemos usar la clase:
use Colectivo;
my $rapido = Colectivo->new(nombre => 129);
print $rapido->nombre; # imprime 129
$rapido->color("amarillo"); # configura el color
Notar que no se definió el método new, Moose lo hace por nosotros.
Ahora bien, Colectivo hereda de Transporte. Para expresar eso facilmente en Transporte.pm escribimos:
package Transporte;
use Moose;
has 'nombre' => (is => 'rw');
has 'color' => (is => 'rw');
1;
Y entonces actualizamos nuestro Colectivo.pm:
package Colectivo;
use Moose;
extends 'Transporte';
1;
Notar que 'extends' reemplaza el tradicional uso de 'base' y configura el array @ISA.
En este momento, Colectivo y Transporte son identicos. Ellos pueden ser instanciados y tienen sus dos atributos. Lo que distingue a un Colectivo de otros medios de Transporte es su bocina. Nosotros lo agregamos aquí:
package Colectivo;
use Moose;
extends 'Transporte';
sub bocina { 'tuturururu' }
1;
y luego hacer referencia a eso en el método común "tocar" de la clase Transporte:
package Transporte;
use Moose;
has 'nombre' => (is => 'rw');
has 'color' => (is => 'rw');
sub tocar {
my $self = shift;
print $self->nombre, " hace ", $self->bocina, "\n";
}
sub bocina { confess shift, " deberia haber definido una bocina!" }
1;
Notar el uso de "confess", si la clase derivada no tiene definido un método bocina, se quejará. Pero como Colectivo definió su bocina, nunca ejecutará Transporte::bocina(). Ahora puedo crear mi colectivo:
my $rapido = Colectivo->new(nombre => 129);
$rapido->tocar; # toca la bocina "tuturururu"
Hasta ahora hemos codificado cosas que sin Moose serian simples de hacer, comenzaremos a complicarnos para ver su verdadero poder. Primero, un Transporte es una clase abstracta que se usa solamente para proveer atributos y métodos comunes a una clase concreta (en este caso, la clase Colectivo). En términos de Moose, esto se describe como un rol. Un rol nunca tiene instancias, porque no es una clase completa.
Cuando convertimos la clase Transporte en un rol obtenemos algo de soporte adicional:
package Transporte;
use Moose::Role;
has 'nombre' => (is => 'rw');
has 'color' => (is => 'rw');
sub tocar {
my $self = shift;
print $self->nombre, " hace ", $self->bocina, "\n";
}
requires 'bocina';
1;
Notar que reemplazamos el 'confess' por un requires. Esto informa a Moose que este rol debe ser usado con una clase que provea el método 'bocina', lo cual se chequea en tiempo de compilacion. Para el rol, nosotros lo vamos a 'usar' más que 'extenderlo':
package Colectivo;
use Moose;
with 'Transporte';
sub bocina { 'tuturururu' }
1;
Si nos faltara incluir 'bocina' obtendríamos una notificación bien temprano. Eso es bueno! En este caso Colectivo trabaja igual que antes.
Qué pasa con 'with' y 'requires'. Debido a que son definidos por Moose y Moose::Role, ellos permanecen como parte del package. Para los puristas que hay en nosotros, no nos gusta este tipo de contaminación, nosotros podemos borrarlos cuando hayamos terminado, usando el correspondiente 'no' (similar al uso de 'strict' y 'no strict'). Por ejemplo, limpiando Colectivo.pm:
package Colectivo;
use Moose;
with 'Animal';
sub bocina { 'tuturururu' }
no Moose; # sacando los andamios
1;
En forma similar, Transporte.pm no requiere Moose::Role al final.
Moose soporta la noción de valor por defecto. Agregaremos un color por defecto y haremos que sea la clase la responsable:
package Transporte;
...
has 'color' => (is => 'rw', default => sub { shift->default_color });
requires 'default_color';
...
Si el color no es provisto, el color por defecto de la clase será consultado a través del método default_color(), y 'requires' asegura que la clase concreta provea este método. Nuestras clases derivadas de Transporte lucirían así:
## Avion.pm:
package Avion;
use Moose;
with 'Transporte';
sub default_color { 'blanco' }
sub bocina { 'trom' }
no Moose;
1;
## Colectivo.pm:
package Colectivo;
use Moose;
with 'Transporte';
sub default_color { 'amarillo' }
sub bocina { 'tuturururu' }
no Moose;
1;
## Bicicleta.pm:
package Bicicleta;
use Moose;
with 'Transporte';
sub default_color { 'roja' }
sub bocina { 'tilin' }
no Moose;
1;
Ahora tenemos Bicicleta entre nuestras clases implementadas:
use Bicicleta;
my $ligera = Bicicleta->new(color => 'azul', nombre => 'Ligera');
$ligera->tocar; # imprime "Ligera hace tilin"
Bueno, esto fue bastante sencillo. Ahora resolveremos otros problemillas.
La clase Ambulancia es especial, porque cuando toca su bocina los demás transportes deben apartarse del camino. En forma tradicional usaríamos una llamada a SUPER:: para llamar al comportamiento de la clase padre, pero esto no funciona con roles. Los roles no quedan en @ISA, porque son 'pegados' en el lugar en vez de 'encimados'.
Afortunadamente, Moose provee el conveniente 'after' para agregar comportamiento adicional a un método existente. Moose reemplaza el método original conservando el contexto (lista, escalar o void) así como su valor de retorno. Nuestro método 'tocar' para Ambulancia quedaría así:
package Ambulancia;
use Moose;
with 'Transporte';
sub default_color { 'blanca' }
sub bocina { 'huuuuuu' }
after 'tocar' => sub {
print "Apartense!\n";
};
no Moose;
1;
Esto produce una ambulancia que funciona bien:
my $ambu = Ambulancia->new(nombre => 'Urgencia');
$ambu->tocar;
resulta:
Urgencia hace huuuuuu
Apartense!
También podemos usar 'before' y 'around' para preceder al comportamiento original o controlar la llamada del comportamiento original, según sea necesario. Por ejemplo, para permitir que 'nombre' sea usado como método de acceso y aún como un método de clase que devuelve un Transporte sin nombre, podemos rodear el 'nombre' con 'around':
package Transporte;
...
has 'nombre' => (is => 'rw');
around 'nombre' => sub {
my $next = shift;
my $self = shift;
blessed $self ? $self->$next(@_) : "un $self sin nombre";
};
El 'has' crea el comportamiento original. El 'around' intercepta la llamada a 'nombre' y toma el coderef como primer parámetro en la variable $next y el original $self como segundo parámetro. Testea $self y si es un objeto llama al original coderef con el resto de los parámetros en @_. Así se obtiene el comportamiento original (un getter o setter) para el objeto, pero si es una clase nos devuelve un string literal.
What if we never gave our animal a nombre? We'll get warnings about undefined values. We can give a default nombre just as we did a default color:
¿Y qué sucede si nunca le damos nombre a nuestro Transporte? Vamos a recibir warnings por valores indefinidos. Podemos dar un 'nombre' por defecto tal como lo hicimos con 'color':
has 'nombre' => (
is => 'rw',
default => sub { 'un '. ref shift .' sin nombre ' },
);
De nuevo, nos place que 'around' inmediatamente siga este paso.
Si no queremos que la gente cambie el color después de la creación de la instancia inicial, podemos declarar el atributo de sólo lectura:
has 'color' => (is => 'ro', default => sub { shift->default_color });
Ahora un intento de establecer el color aborta con el mensaje 'Cannot assign a value to a read-only accessor'. Si realmente quisiera tener una manera de establecer el color de vez en cuando, podemos definir un escritor separado:
has 'color' => (
is => 'ro',
writer => 'private_set_color',
default => sub { shift->default_color },
);
Por lo tanto, no podemos cambiar el color de una bicileta directamente:
my $ligera = Bicicleta->new;
my $color = $ligera->color; # método getter obtiene el color
$ligera->color('verde'); # MUERE
Sin embargo, podemos utilizar nuestro método privado en su lugar:
$ligera->private_set_color('verde'); # método setter privado
Mediante el uso de un nombre de largo, hacemos menos probable que accidentalmente lo llamen, a menos que intencionalmente querramos cambiar el color.
Vamos a crear una bicicleta de carreras, BicicletaCarrera, mediante el agregado de características de competición a una bicicleta. En primer lugar definimos las características de competición usando roles, claro:
package Competidor;
use Moose::Role;
has $_ => (is => 'rw', default => 0)
foreach qw(victorias posicion shows perdidas);
no Moose::Role;
1;
Tenga en cuenta que desde que 'has' es solo una llamada a función, podemos utilizar las estructuras tradicionales de control de Perl (en este caso, un bucle foreach). Con un poco de código, hemos añadido otros cuatro atributos.
El valor inicial de 0 significa que no tienes que escribir el código de inicialización independiente en nuestro constructor.
Ahora, podemos añadir algunos métodos de acceso:
package Competidor;
...
sub gano { my $self = shift; $self->victorias($self->victorias + 1) }
sub aplazado { my $self = shift; $self->posicion($self->posicion + 1) }
sub showed { my $self = shift; $self->shows($self->shows + 1) }
sub perdio { my $self = shift; $self->perdidas($self->perdidas + 1) }
sub tabla_posiciones {
my $self = shift;
join ", ", map { $self->$_ . " $_" } qw(victorias posicion shows perdidas);
}
...
Cada llamada al método 'gano' incrementa el número de victorias. Esto sería más sencillo si se presume que estos objetos se implementan como hashes (que lo son por defecto), como:
sub gano { shift->{victorias}++; }
Sin embargo, mediante el uso de la interfaz pública (una llamada de método), podríamos cambiar la posterior implementación de adentro hacia afuera del objeto usando arreglos sin romper este código. Esto es especialmente importante cuando se crea un rol genérico, que podría mezclarse con cualquier tipo de objeto.
Para crear la bicicleta de carreras, mezlcamos una Bicicleta con un Competidor:
package BicicletaCarrera;
use Moose;
extends 'Bicicleta';
with 'Competidor';
no Moose;
1;
Y ahora podemos montar las bicicletas!:
use BicicletaCarrera;
my $bici = BicicletaCarrera->new(nombre => 'ligera');
$bici->gano; $bici->gano; $bici->gano;
$bici->aplazado;
$bici->perdio; # corremos algunas carreras
print $bici->tabla_posiciones, "\n";
# 3 ganadas, 1 aplazada, 0 shows, 1 perdida
Hasta ahora, sólo he arañado la superficie de lo que ofrece Moose. Ahora a codificar y ganar experiencia!
