Evolución del estilo en Perl

[English translation]

Las técnicas y el estilo en la programación es una de esas cosas que van cambiando con el tiempo, como Perl permite extender el lenguaje con facilidad, se forma un círculo evolutivo cuando a su vez las extensiones popularizan nuevos estilos de programación.

Hoy intento dar un rápido vistazo a varias maneras de programar en Perl que he utilizado durante los años, con la esperanza de que podáis apreciar las ventajas del estilo de la programación moderna en Perl.

Todos los programas de este artículo tienen el mismo objetivo, jugar el juego de los animales, que da la ilusión de que la computadora aprende. Sin embargo, no todos los programas utilizan las mismas estructuras de datos o logran el mismo nivel de robustez, en este sentido los estilos "antiguos" son menos robustos que los modernos.

Perl5 Antiguo

En los principios de Perl5 las computadoras tenían menos capacidad, así que los programas solían escribirse de manera bastante compacta, además se usaban "trucos inteligentes", como el uso de los hashes en este programa, en el cual no es fácil comprender como funciona exactamente %tree en el programa:

Estilo 1: Antiguo

 1 #!/usr/bin/env perl
 2 sub prompt {
 3     print $_[0];
 4     $line = <>;
 5     chomp $line;
 6     $line;
 7 }
 8 
 9 sub si {
10     prompt("$_[0]? (s/n): ") =~ /^\s*s/i;
11 }
12 
13 $pregunta = $root = "vive en el agua";
14 %tree = ( $root => [ 'tigre', 'tiburón' ] );
15 do {
16     {
17         $branch   = si($pregunta);
18         $guess    = $tree{$pregunta}[$branch];
19         $pregunta = $guess, redo if $tree{$guess};
20         $pregunta = $root, next if si("Es un(a) $guess");
21         $animal   = prompt("Nombre del animal: ");
22         $diff     = prompt( "Una pregunta cierta para $animal" .
23                             " pero falsa para $guess: " );
24         $tree{$diff} = [ $tree{$pregunta}[$branch], $animal ];
25         $tree{$pregunta}[$branch] = $diff;
26         $pregunta = $root
27     }
28 } while si("Quieres jugar de nuevo");

Son programas como esos lo que le dieron la (mala) fama de lenguaje de solo escritura. Sin embargo por aquellos días se valoraba mucho la inteligencia, y se inventaron los torneos de golf (la comunidad de Perl es la única que conozco que ha jugado golf con el lenguaje). En un partido de golf el programa anterior podría terminar fácilmente como se muestra a continuación:

Estilo 2: Golf

1 #!/usr/bin/env perl
2 sub p{print$_[0];$l=<>;chomp$l;$l}sub a{p("$_[0]? (s/n): ")=~/^\s*s/i}$q=
3 $s="vive en el agua";%t=($s=>["tigre","tiburón"]);do {{$v=a($q);$a=$t{$q}[$v];
4 $q=$a,redo if$t{$a};$q=$s,next if a"Es un(a) $a";$n=p"Nombre del animal: ";
5 $o=p"Una pregunta cierta para $n pero falsa para $a: ";$t{$o}
6 =[$t{$q}[$v],$n];$t{$q}[$v]=$o;$q=$s}}while a"Quieres jugar de nuevo";

Como te imaginarás, programas como el anterior solo lograron empeorar la situación,pues la práctica de este estilo terminó en lugares donde no debió usarse,programas que necesitaban mantenimiento y que por supuesto eran difíciles de mantener. Aun utilizando herramientas como perltidy que reformatean por completo el programa haciendo visible su estructura, es difícil comprenderlo:

Estilo 3: Sucinto

 1 #!/usr/bin/env perl
 2 sub p { print $_[0]; $l = <>; chomp $l; $l }
 3 sub a { p("$_[0]? (s/n): ") =~ /^\s*s/i }
 4 $q = $s = "vive en el agua";
 5 %t = ( $s => [ "tigre", "tiburón" ] );
 6 do {
 7     {
 8         $v = a($q);
 9         $a = $t{$q}[$v];
10         $q = $a, redo if $t{$a};
11         $q = $s, next if a("Es un(a) $a");
12         $n = p("Nombre del animal: ");
13         $o = p("Una pregunta cierta para $n pero falsa para $a: ");
14         $t{$o} = [ $t{$q}[$v], $n ];
15         $t{$q}[$v] = $o;
16         $q = $s
17     }
18 } while a("Quieres jugar de nuevo");

Los nombres en las variables son inútiles, los ciclos son difíciles de seguir y la estructura de datos que se utiliza utiliza trucos muy "inteligentes", que además no funcionan correctamente en algunos casos poco usuales, esto fue típico de alguna época, en las que las soluciones rápidas y sucias fueron mas la norma que la excepción.

Procedimientos y DSL

En este estilo se usan mucho los prototipos convirtiendo cada subrutina en operadores que a veces son difíciles de seguir. Los objetos se utilizan mediante la sintaxis indirecta que trae algunos problemas de ambigüedad.

Estilo 4: Procedimientos y DSL

 1 #!/usr/bin/env perl
 2 use Term::ReadLine;
 3 
 4 use strict;
 5 
 6 my $term = new Term::ReadLine "El juego de los animales";
 7 
 8 sub prompt($) { $term->readline(shift) }
 9 
10 sub si($) {
11     my $prompt = shift;
12     while ( my $answer = prompt "$prompt? (s/n): " ) {
13         return $answer =~ /^\s*((si|s)|(no|n))\s*/i;
14         print { $term->OUT } "Por favor responda 's' o 'n'\n";
15     }
16 }
17 
18 sub play {
19     my $guess = shift;
20     my ($node, $branch);
21     while ( ref $guess ) {
22         $node = $guess;
23         $branch = si $node->{pregunta};
24         $guess = $node->{ramas}[$branch];
25     }
26     return if si "Es un(a) $guess";
27     my $animal = prompt "Nombre del animal: ";
28     my $diff   = prompt "Una pregunta cierta para $animal" .
29                         " pero falsa para $guess: ";
30     $node->{ramas}[$branch] = { pregunta => $diff, ramas => [ $guess, $animal ] };
31 }
32 
33 my $tree = { pregunta => 'vive en el agua', ramas => [ 'tigre', 'tiburón' ] };
34 play $tree;
35 play $tree while si "Quieres jugar de nuevo";

No es que esto este del todo mal, en efecto usar los prototipos permite hacer extender Perl como lo hace Moose, usando el azúcar sintáctico que proveen las subrutinas en Perl.

Una característica interesante de este nuevo programa es una lógica mejor organizada y una estructura de datos mucho más fácil de comprender, sin embargo todavía usa algunas cosas inteligentes, como el acceso a las ramas utilizando el resultado de la comparación en la subrutina si() que retorna 1 en caso de ser cierto, pero undef en caso contrario, claro que Perl convierte undef en "" o en 0 según el contexto en que se use, pero no es una buena práctica andar haciendo eso por todos lados.

Clases hechas a mano

Los objetos en Perl como en cualquier otro lenguaje trajeron las ventajas del encapsulamiento, consistencia y el reuso del código, sin embargo, para obtener todas las ventajas de este tipo de programación había que hacer métodos (subrutinas) que controlaran el acceso a los atributos. Hacer esto en Perl era laborioso, repetitivo y muy muy aburrido:

Estilo 5: Objetos hechos a mano

 1 package QuestionNode;
 2 use Carp;
 3 use strict;
 4 
 5 sub new {
 6     my ( $class, $pregunta, $no, $si ) = @_;
 7     bless { pregunta => $pregunta, no => $no, si => $si }, ref $class || $class;
 8 }
 9 
10 sub pregunta {
11     my $self = shift;
12     return $self->{pregunta} unless @_;
13     croak "pregunta es un atributo de solo lectura";
14 }
15 
16 sub si {
17     my $self = shift;
18     return $self->{si} unless @_;
19     return $self->{si} = shift;
20 }
21 
22 sub no {
23     my $self = shift;
24     return $self->{no} unless @_;
25     return $self->{no} = shift;
26 }
27 
28 1;

 1 #!/usr/bin/env perl
 2 use QuestionNode;
 3 use Term::ReadLine;
 4 use IO::Handle;
 5 
 6 use strict;
 7 
 8 my $term = Term::ReadLine->new("El juego de los animales");
 9 
10 sub prompt($) { $term->readline(shift) }
11 
12 sub si($) {
13     my $prompt = shift;
14     while (1) {
15         my $answer = prompt("$prompt? (y/n): ");
16         return ( $2 ? 1 : 0 ) if $answer =~ /^\s*((si|s)|(no|n))\s*/i;
17         $term->OUT->print("Responde 's' o 'n'\n");
18     }
19 }
20 
21 sub play {
22     my $guess = shift;
23     my ( $node, $branch );
24     while ( ref $guess ) {
25         $node   = $guess;
26         $branch = si $node->pregunta ? "si" : "no";
27         $guess  = $node->$branch;
28     }
29     return if si "Es un(a) $guess";
30     my $animal = prompt "Nombre del animal: ";
31     my $diff   = prompt
32         "Una pregunta cierta para $animal pero falsa para $guess: ";
33     $node->$branch( QuestionNode->new( $diff, $guess, $animal ) );
34 }
35 
36 my $tree = new QuestionNode( 'vive en el agua', 'tigre', 'tiburón' );
37 play $tree;
38 play $tree while si "Quieres jugar de nuevo";
39 

En el ejemplo se siguen usando los prototipos y la sintaxis indirecta para algunas cosas y para otras no.

Hacer los accessors en la clase QuestionNode era claramente una labor repetitiva y rápidamente la comunidad le buscó varias soluciones a este problema, que fueron agregadas al CPAN.

Asistentes de Clases

En el CPAN florecieron muchas herramientas que facilitaban la programación orientada a objetos, desde pragmas como "fields" que verificaban las claves de un hash a tiempo de compilación hasta los objetos invertidos (inside-out) implementados por Class::Std que mejoraban la encapsulación.

Yo fui un fanático de Class::Accessor (en realidad de Class::Accessor::Fast), y si hubiera hecho el programa en aquella época quedaría así:

Estilo 6: Objetos asistidos

game.pl:

1 #!/usr/bin/env perl
2 use AnimalsGame;
3 AnimalsGame->new->run;

QuestionNode.pm:

1 package QuestionNode;
2 use base "Class::Accessor";
3 use strict;
4 
5 __PACKAGE__->mk_ro_accessors("pregunta");
6 __PACKAGE__->mk_accessors("si", "no");
7 
8 1;

AnimalsGame.pm:

 1 package AnimalsGame;
 2 use QuestionNode;
 3 use Term::ReadLine;
 4 use IO::Handle;
 5 use base "Class::Accessor";
 6 use strict;
 7 
 8 __PACKAGE__->mk_ro_accessors(qw(tree term));
 9 
10 sub prompt {
11     my $self = shift;
12     $self->term->readline(shift);
13 }
14 
15 sub si {
16     my $self   = shift;
17     my $prompt = shift;
18     while (1) {
19         my $answer = $self->prompt("$prompt? (y/n): ");
20         return ( $2 ? 1 : 0 ) if $answer =~ /^\s*((si|s)|(no|n))\s*/i;
21         $self->term->OUT->print("Responde 's' o 'n'\n");
22     }
23 }
24 
25 sub play {
26     my $self  = shift;
27     my $guess = $self->tree;
28     my ( $node, $branch );
29     while ( ref $guess ) {
30         $node   = $guess;
31         $branch = $self->si( $node->pregunta ) ? "si" : "no";
32         $guess  = $node->$branch;
33     }
34     return if $self->si("Es un(a) $guess");
35     my $animal = $self->prompt("Nombre del animal: ");
36     my $diff   = $self->prompt(
37         "Una pregunta cierta para $animal pero falsa para $guess: ");
38     $node->$branch( QuestionNode->new(
39         { pregunta => $diff, no => $guess, si => $animal } ) );
40 }
41 
42 sub new {
43     my $class = shift;
44     my $opt   = shift || {};
45     my $title = $opt->{title} || "El juego de los animales";
46     my $term  = $opt->{term}  || Term::ReadLine->new($title);
47     my $tree  = $opt->{tree}  || QuestionNode->new(
48         { pregunta => 'vive en el agua', no => 'tigre', si => 'tiburón' } );
49     return $class->SUPER::new( { tree => $tree, term => $term } );
50 }
51 
52 sub run {
53     my $self = shift;
54     $self->play;
55     $self->play while $self->si("Quieres jugar de nuevo");
56 }
57 
58 1;

Las herramientas de asistencia de OOP captaron la atención del programador y los programas en Perl, se hicieron más fáciles de entender y programar de manera robusta.

Moose

Este sistema es la última palabra en OOP para Perl.

En particular voy a mostrar como sería el programa utilizando herencia múltiple y composición (roles, rasgos, mixins, ...), yo me estoy volviendo un fanático de la última, pues permite implementar objetos como jugar con LEGO evitando algunos problemas comunes de la herencia múltiple. Sin embargo, primero el ejemplo con herencia múltiple.

Estilo 7: Moose con herencia múltiple

game.pl:

 1 #!/usr/bin/env perl
 2 package Game;
 3 use Moose;
 4 
 5 extends qw(AnimalsGame ConsoleGame);
 6 
 7 __PACKAGE__->meta->make_immutable;
 8 no Moose;
 9 
10 Game->new->run;

AnimalsGame.pm:

 1 package AnimalsGame;
 2 use Moose;
 3 use QuestionNode;
 4 
 5 has tree => (
 6     is      => "ro",
 7     isa     => "QuestionNode",
 8     default => sub {
 9         QuestionNode->new(
10             { pregunta => 'vive en el agua', no => 'tigre', si => 'tiburón' } );
11     }
12 );
13 
14 sub play {
15     my $self  = shift;
16     my $guess = $self->tree;
17     my ( $node, $branch );
18     while ( ref($guess) ) {
19         $node   = $guess;
20         $branch = $self->si( $node->pregunta ) ? "si" : "no";
21         $guess  = $node->$branch;
22     }
23     return if $self->si("Es un(a) $guess");
24     my $animal = $self->prompt("Nombre del animal: ");
25     my $diff   = $self->prompt(
26         "Una pregunta cierta para $animal pero falsa para $guess: ");
27     $node->$branch(
28         QuestionNode->new( { pregunta => $diff, no => $guess, si => $animal } ) );
29 }
30 
31 __PACKAGE__->meta->make_immutable;
32 1;

ConsoleGame.pm:

 1 package ConsoleGame;
 2 use Moose;
 3 use Term::ReadLine;
 4 use IO::Handle;
 5 
 6 has title => ( is => "ro", isa => "Str", default => "El juego de los animales" );
 7 has term  => ( is => "ro", isa => "Object", lazy_build => 1,
 8                handles => { prompt => "readline" } );
 9 
10 sub _build_term {
11     my $self = shift;
12     Term::ReadLine->new( $self->title );
13 }
14 
15 sub si {
16     my $self   = shift;
17     my $prompt = shift;
18     while (1) {
19         my $answer = $self->prompt("$prompt? (y/n): ");
20         return ( $2 ? 1 : 0 ) if $answer =~ /^\s*((si|s)|(no|n))\s*/i;
21         $self->term->OUT->print("Responde 's' o 'n'\n");
22     }
23 }
24 
25 sub run {
26     my $self = shift;
27     $self->play;
28     $self->play while $self->si("Quieres jugar de nuevo");
29 }
30 
31 __PACKAGE__->meta->make_immutable;
32 1;

QuestionNode.pm

1 package QuestionNode;
2 use Moose;
3 
4 has pregunta => ( is => "ro", isa => "Str", required => 1 );
5 has [ "si", "no" ] => ( is => "rw", isa => "Str|QuestionNode", required => 1 );
6 
7 __PACKAGE__->meta->make_immutable;
8 1;

Moose es capaz de generar una cantidad de código muy superior a la de herramientas anteriores, que se limitaban a generar las clases y los accessors para los atributos, en Moose se pueden especificar restricciones de tipo, que pueden llegar a ser complejas. Así en QuestionNode "pregunta" es un "Str" (cadena de caracteres), mientras que "si" y "no" pueden ser "Str" o un objeto "QuestionNode", Moose se encarga de implementar todo el código para garantizar ese contrato.

A continuación el ejemplo utilizando composición de objetos, una de las características más resaltantes de este ejemplo es que casi no hay que cambiar nada para utilizar la composición de objetos, lo que habla bastante bien de las capacidades de abstracción de Moose para la reutilización de código.

En este caso la clase Game se arma agregando una clase ConsoleGame (con sus atributos) y una clase AnimalsGame que a su vez usa objetos del tipo QuestionNode.

Estilo 8: Moose con Roles.

en game.pl solo cambia en la línea 5, "extend" por "with":

 
 5 with qw(AnimalsGame ConsoleGame);

en AnimalsGame.pm y ConsoleGame.pm solo se cambia la línea 2 para convertir las clases en roles y se elimina la línea 31 que solo tiene sentido para las clases (solo las clases necesitan hacerse inmutables para tener un mejor rendimiento).

 2 use Moose::Role;

Espero que este artículo te ayude a establecer similitudes y paralelos entre las técnicas que actualmente usas y Moose, que es básicamente el futuro de la programación orientada a objetos en Perl5, pero que además es la manera más fácil de aprender y afianzar conceptos que te serán útiles cuando quieras comenzar a utilizar Perl6.

Otra ventaja (quizás más importante) de programar en Moose, es lograr un estándar de OOP que todos puedan aprender fácilmente, la diversidad de sistemas de OOP, no le hace del todo bien al lenguaje, ya que por alguna razón la gente quiere una sola interfaz, Moose hace esto posible ya que es lo suficiente flexible y potente para implementar cualquier cualquier cosa que se te ocurra.

No esperes más. usa Moose. ¡YA!