[
Original Spanish source]
Programming style is one of those things that change over time, since Perl is easily extended, a circle is closed when when the evolved extensions popularize new styles of programming.
Today I'll try to give a quick look at several styles of Perl programming that I have used over the years, I hope that you will appreciate the advantages of modern programming style in Perl.
All programs in this article have the same goal, to play the animal's guessing game, which gives the illusion that the computer learns. However, not all programs use the same data structures or achieve the same level of robustness, in this sense the old styles are less robust than modern ones.
Ancient Perl5
In Perl5 early beginnings computers were less powerfull, so programs written often quite compact, and also used "clever tricks" such as the use of hashes in the next program, in which is not easy to understand how %tree is used:
Style 1: Old perl.
1 #!/usr/bin/env perl
2 sub prompt {
3 print $_[0];
4 $line = <>;
5 chomp $line;
6 $line;
7 }
8
9 sub yes {
10 prompt("$_[0]? (y/n): ") =~ /^\s*y/i;
11 }
12
13 $question = $root = "lives in the water";
14 %tree = ( $root => [ 'tiger', 'shark' ] );
15 do {
16 {
17 $branch = yes($question);
18 $guess = $tree{$question}[$branch];
19 $question = $guess, redo if $tree{$guess};
20 $question = $root, next if yes("Is it a(n) $guess");
21 $animal = prompt("Animal's name? : ");
22 $diff = prompt( "A question true for $animal" .
23 ", but false for $guess: " );
24 $tree{$diff} = [ $tree{$question}[$branch], $animal ];
25 $tree{$question}[$branch] = $diff;
26 $question = $root
27 }
28 } while yes("Do you want to play again");
Programs like these are what gave Perl the (bad) reputation as a write-only language. But in those days smartness was highly valued, so golf tournaments where born (the Perl community is the only one I know who has played golf with language). After such a tournament the previous program would become something like:
Style 2: Golf
1 #!/usr/bin/env perl
2 sub p{print$_[0];$l=<>;chomp$l;$l}sub a{p("$_[0]? (y/n): ")=~/^\s*y/i}$q=
3 $s="lives in the water";%t=($s=>["tiger","shark"]);do {{$v=a($q);$a=$t{$q}[$v];
4 $q=$a,redo if$t{$a};$q=$s,next if a"Is it a(n) $a";$n=p"Animal's name? : ";
5 $o=p"A question true for $n, but false for $a: ";$t{$o}
6 =[$t{$q}[$v],$n];$t{$q}[$v]=$o;$q=$s}}while a"Do you want to play again";
As you can imagine, as the previous program only managed to worsen the situation, the practice of this style ended up in places where it should not, programs that needed maintenance and that of course were difficult to maintain with this coding style. Even using tools like perltidy to reformat the entire program, making its structure visible, is difficult to understand:
Style 3: Succinct
1 #!/usr/bin/env perl
2 sub p { print $_[0]; $l = <>; chomp $l; $l }
3 sub a { p("$_[0]? (y/n): ") =~ /^\s*y/i }
4 $q = $s = "lives in the water";
5 %t = ( $s => [ "tiger", "shark" ] );
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("Is it a(n) $a");
12 $n = p("Animal's name? : ");
13 $o = p("A question true for $n, but false for $a: ");
14 $t{$o} = [ $t{$q}[$v], $n ];
15 $t{$q}[$v] = $o;
16 $q = $s
17 }
18 } while a("Do you want to play again");
The variable names are useless, the loops are difficult to follow and the data structure used "smart tricks", which by the way does not work correctly in some unusual cases, this was typical of that era, in which quick and dirty solutions were more the norm than the exception.
Procedures and DSL
In this style prototypes are widely used, converting subroutines into operators, that sometimes are difficult to follow. Objects where used by indirect syntax which brings some ambiguity problems.
Style 4: Procedural/DSL
1 #!/usr/bin/env perl
2 use Term::ReadLine;
3
4 use strict;
5
6 my $term = new Term::ReadLine "Animals' game";
7
8 sub prompt($) { $term->readline(shift) }
9
10 sub yes($) {
11 my $prompt = shift;
12 while ( my $answer = prompt "$prompt? (y/n): " ) {
13 return $answer =~ /^\s*((yes|y)|(no|n))\s*/i;
14 print { $term->OUT } "Please answer 'y' or '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 = yes $node->{question};
24 $guess = $node->{branches}[$branch];
25 }
26 return if yes "Is it a(n) $guess";
27 my $animal = prompt "Animal's name? : ";
28 my $diff = prompt "A question true for $animal" .
29 ", but false for $guess: ";
30 $node->{branches}[$branch] = { question => $diff, branches => [ $guess, $animal ] };
31 }
32
33 my $tree = { question => 'lives in the water', branches => [ 'tiger', 'shark' ] };
34 play $tree;
35 play $tree while yes "Do you want to play again";
Using prototypes is not completely wrong, after some modules use them effectively to add sugar syntax to Perl, but using them everywhere tends to be confusing.
An interesting feature of this new program is that is better organized and uses a better data structure much easier to understand, but still uses some clever tricks, including access to the branches using the result of the match in the yes() subroutine, that returns 1 if matched, but otherwise undef, that becomes "" or 0 depending on the used context, but anyway is not very clear and usually code like ends in bugs, thats why it produces warnings.
Hand made classes
Objects in Perl as in any other language brought the advantages of encapsulation, consistency and code reuse, however, to take full advantage of this type of programming, the programmer had to make methods (subroutines) to control access to the attributes. Doing this in Perl was laborious, repetitive and very boring:
Style 5: Hand made classes
game.pl:
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("Animals' game");
9
10 sub prompt($) { $term->readline(shift) }
11
12 sub yes($) {
13 my $prompt = shift;
14 while (1) {
15 my $answer = prompt("$prompt? (y/n): ");
16 return ( $2 ? 1 : 0 ) if $answer =~ /^\s*((yes|y)|(no|n))\s*/i;
17 $term->OUT->print("Please answer 'y' or '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 = yes $node->question ? "yes" : "no";
27 $guess = $node->$branch;
28 }
29 return if yes "Is it a(n) $guess";
30 my $animal = prompt "Animal's name? : ";
31 my $diff = prompt
32 "A question true for $animal, but false for $guess: ";
33 $node->$branch( QuestionNode->new( $diff, $guess, $animal ) );
34 }
35
36 my $tree = new QuestionNode( 'lives in the water', 'tiger', 'shark' );
37 play $tree;
38 play $tree while yes "Do you want to play again";
39
QuestionNode.pm:
1 package QuestionNode;
2 use Carp;
3 use strict;
4
5 sub new {
6 my ( $class, $question, $no, $yes ) = @_;
7 bless { question => $question, no => $no, yes => $yes }, ref $class || $class;
8 }
9
10 sub question {
11 my $self = shift;
12 return $self->{question} unless @_;
13 croak "question is a read only attribute";
14 }
15
16 sub yes {
17 my $self = shift;
18 return $self->{yes} unless @_;
19 return $self->{yes} = shift;
20 }
21
22 sub no {
23 my $self = shift;
24 return $self->{no} unless @_;
25 return $self->{no} = shift;
26 }
27
28 1;
The example is still using the prototypes and the indirect syntax for some things.
Making QuestionNode accessors in the class was clearly a repetitive work and the community quickly found him several solutions to this problem, which were added to CPAN.
Class Assistants
CPAN flourished with many tools to facilitate the object-oriented programming, from pragmas as "fields" which checked the keys of a hash at compile time, to inside-out objects which improved the encapsulation as implemented by Class::Std.
I was a fan of Class::Accessor (in fact Class::Accessor::Fast), and if I had made the program at that time it would look like this:
Style 6: Class Assistants
game.pl:
1 #!/usr/bin/env perl
2 use AnimalsGame;
3 AnimalsGame->new->run;
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 yes {
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*((yes|y)|(no|n))\s*/i;
21 $self->term->OUT->print("Please answer 'y' or '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->yes( $node->question ) ? "yes" : "no";
32 $guess = $node->$branch;
33 }
34 return if $self->yes("Is it a(n) $guess");
35 my $animal = $self->prompt("Animal's name? : ");
36 my $diff = $self->prompt(
37 "A question true for $animal, but false for $guess: ");
38 $node->$branch( QuestionNode->new(
39 { question => $diff, no => $guess, yes => $animal } ) );
40 }
41
42 sub new {
43 my $class = shift;
44 my $opt = shift || {};
45 my $title = $opt->{title} || "Animals' game";
46 my $term = $opt->{term} || Term::ReadLine->new($title);
47 my $tree = $opt->{tree} || QuestionNode->new(
48 { question => 'lives in the water', no => 'tiger', yes => 'shark' } );
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->yes("Do you want to play again");
56 }
57
58 1;
QuestionNode.pm:
1 package QuestionNode;
2 use base "Class::Accessor";
3 use strict;
4
5 __PACKAGE__->mk_ro_accessors("question");
6 __PACKAGE__->mk_accessors("yes", "no");
7
8 1;
The OOP support tools caught the programmers attention and Perl programs were made easier to understand and write robustly.
Moose
This system is the last word in Perl OOP.
I will show how the program would be using multiple inheritance and composition (roles, traits, mixins, ...), I'm becoming a fan of the latter, it allows to implement objects like playing with LEGO, avoiding some common problems of multiple inheritance. But first the example with multiple inheritance.
Style 7: Moose with multiple inheritance
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 { question => 'lives in the water', no => 'tiger', yes => 'shark' } );
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->yes( $node->question ) ? "yes" : "no";
21 $guess = $node->$branch;
22 }
23 return if $self->yes("Is it a(n) $guess");
24 my $animal = $self->prompt("Animal's name? : ");
25 my $diff = $self->prompt(
26 "A question true for $animal, but false for $guess: ");
27 $node->$branch(
28 QuestionNode->new( { question => $diff, no => $guess, yes => $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 => "Animals' game" );
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 yes {
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*((yes|y)|(no|n))\s*/i;
21 $self->term->OUT->print("Please answer 'y' or 'n'\n");
22 }
23 }
24
25 sub run {
26 my $self = shift;
27 $self->play;
28 $self->play while $self->yes("Do you want to play again");
29 }
30
31 __PACKAGE__->meta->make_immutable;
32 1;
QuestionNode.pm
1 package QuestionNode;
2 use Moose;
3
4 has question => ( is => "ro", isa => "Str", required => 1 );
5 has [ "yes", "no" ] => ( is => "rw", isa => "Str|QuestionNode", required => 1 );
6
7 __PACKAGE__->meta->make_immutable;
8 1;
Moose is capable of generating a greater amount of code than the previous tools, which merely generate classes and accessors for attributes, in Moose it is easy to make type constraints, even complex ones. So in QuestionNode "question" is a "Str" (string), while "yes" and "no" may be "Str" or "QuestionNode", and Moose is making all the validation code to ensure that the contracts are fulfilled.
Below is the sample using composition of objects, one of the most important characteristics of this example is that there is hardly anything to change to use object composition, which speaks well about the capabilities of Moose abstraction for code reuse.
Game class is assembled by adding a class ConsoleGame (with its attributes) and a class AnimalsGame which in turn uses objects of type QuestionNode.
game.pl just changes "extend" by "with" al line 5::
5 with qw(AnimalsGame ConsoleGame);
AnimalsGame.pm y ConsoleGame.pm just change Moose by Moose::Role at line 2, while line 31 is deleted because only classes may need immutability to achieve better performance.
2 use Moose::Role;
I hope this article helps you to establish similarities and parallels between the techniques you're currently using and Moose, which is basically the future of Object Oriented Programming in Perl5, but it is also the easiest way to learn and reinforce concepts that will be useful when you want to start using Perl6.
Another advantage (perhaps more important) using Moose, is achieving an OOP standard that everyone can easily learn, the diverse systems of OOP in Perl is not working quite well for language, since people usually likes a single interface, Moose makes this possible because it is flexible and powerful enough to implement any anything that comes to your mind.
Do not wait anymore. use Moose. now.
