tag:blogger.com,1999:blog-6996091720437107972024-02-08T12:25:37.739-04:00PerliscopeAnything about PerlJose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.comBlogger19125tag:blogger.com,1999:blog-699609172043710797.post-49297814286449158202010-07-27T17:49:00.001-04:302010-08-02T01:47:24.066-04:30A tale of two languagesGood <a href="http://www.bofh.org.uk/2010/07/25/a-tale-of-two-languages">article</a> on different styles of perl programming.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.comtag:blogger.com,1999:blog-699609172043710797.post-70003332482876094932010-01-31T07:32:00.003-04:302010-01-31T14:07:00.485-04:30Diet Moose[<a href="http://perliscopio.blogspot.com/2010/01/moose-de-dieta.html">Spanish source</a>]<br />
<br />
Do you think that <a href="http://search.cpan.org/perldoc?Moose">Moose</a> is too heavy for your applications?<br />
<br />
Compiling <a href="http://search.cpan.org/perldoc?Moose">Moose</a> objects can take considerable time during application startup, this could give the impression that programs that use it are slow, however the compilation only happens when loading the program, and depending on the application <a href="http://search.cpan.org/perldoc?Moose">Moose</a> may not be as heavy as it looks.<br />
<br />
One example is a <a href="http://www.catalystframework.org/">Catalyst</a> application (in versions newer than 5.8), when it starts it should compile all objects made with <a href="http://search.cpan.org/perldoc?Moose">Moose</a> and you may notice the difference with previous versions, but as Catalyst is to be run for days or months startup time generally does not matter.<br />
<br />
If the application you want to develop is a command that executes a task and terminates quickly then <a href="http://search.cpan.org/perldoc?Moose">Moose</a> is perhaps too heavy for you, especially when the application may be executed repeatedly via other commands like xargs(1) or find(1).<br />
<br />
For such cases where the application's starting time will not be well amortized with execution, there is a solution in the CPAN: <a href="http://search.cpan.org/perldoc?Mouse">Mouse</a>.<br />
<br />
<a href="http://search.cpan.org/perldoc?Mouse">Mouse</a> is a highly optimized <a href="http://search.cpan.org/perldoc?Moose">Moose</a> replacement that allows the vast majority of the features of <a href="http://search.cpan.org/perldoc?Moose">Moose</a>, but is much lighter because it is developed in XS (ie C) and omits some features to speedup execution.<br />
<br />
According to the manual page of <a href="http://search.cpan.org/perldoc?Mouse">Mouse</a>, <a href="http://search.cpan.org/perldoc?Moose">Moose</a> only fails 1% of the tests, which makes Mouse very upward compatible with Moose, but the test suite runs 400% faster with Mouse and in my experience I can not tell the difference between using <a href="http://search.cpan.org/perldoc?Mouse">Mouse</a> and things like Class::Accessor::Fast, and although the latter may be somewhat faster (something I have not formally tested), having available an OOP system like <a href="http://search.cpan.org/perldoc?Moose">Moose</a> is definitely worth it.<br />
<br />
Using <a href="http://search.cpan.org/perldoc?Mouse">Mouse</a> is very simple, you just need to replace <a href="http://search.cpan.org/perldoc?Moose">Moose</a> by <a href="http://search.cpan.org/perldoc?Mouse">Mouse</a>, everything else is the same as with <a href="http://search.cpan.org/perldoc?Moose">Moose</a>.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com3tag:blogger.com,1999:blog-699609172043710797.post-72463578623376653252010-01-18T08:19:00.001-04:302010-01-18T08:20:20.138-04:30Sweeter Moose[<a href="http://perliscopio.blogspot.com/2010/01/dulce-dulce-moose.html">Original spanish content</a>]<br />
<br />
One comment I received for the previous article was about how would it look using the <a href="http://search.cpan.org/perldoc?MooseX::Declare">MooseX::Declare</a> syntax.<br />
<br />
This module provides syntax extensions that go far beyond the regular Moose syntactic sugar. Using the deep magic of <a href="http://search.cpan.org/perldoc?Devel::Declare">Devel::Declare</a>, <a href="http://search.cpan.org/perldoc?MooseX::Declare">MooseX::Declare</a> creates a whole new syntax very similar to Perl6, for classes and roles in Moose, however, the use of this extension generates mixed feelings for me.<br />
<br />
On one side is the look and simplicity of the syntax implemented, but I noticed that changing the syntax in this way will make tools that I take for granted, like <a href="http://search.cpan.org/perldoc?perltidy">perltidy</a> which gives complains about method prototypes, also modules like <a href="http://search.cpan.org/perldoc?PPI">PPI</a> or vim coloring fail in one way or another.<br />
<br />
I am aware that it is all about repairing <a href="http://search.cpan.org/perldoc?perltidy">perltidy</a>, <a href="http://search.cpan.org/perldoc?PPI">PPI</a> and vim coloring, but the problem is that it is difficult to implement any single sintax that anyone introduces as extensions in CPAN.<br />
<br />
I have always argued that one advantage of <a href="http://search.cpan.org/perldoc?Devel::Declare">Devel::Declare</a> is that it allows Perl5 evolve through CPAN modules as <a href="http://search.cpan.org/perldoc?TryCatch">TryCatch</a> and <a href="http://search.cpan.org/perldoc?MooseX::Declare">MooseX::Declare</a> show syntactic extensions that could eventually be added to Perl5 if widely accepted.<br />
<br />
But how will them become widely accepted, if we do not use them because the tools break?<br />
<br />
Maybe none of this matters because <a href="http://rakudo.org/">Rakudo</a> * <a href="http://use.perl.org/%7Epmichaud/journal/39411">arrives in march 2010</a>, and everybody will start the great migration to Perl6.<br />
<br />
As I do have the same number of arguments for and against, I'll keep pondering which have more weight than others. But in the meantime here are the roles version of the animal's game using <a href="http://search.cpan.org/perldoc?MooseX::Declare">MooseX::Declare</a>, for you to get an idea about their own costs and benefits:<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/env perl</span>
<span style="color: brown;"> 2 </span><span style="color: #a020f0;">use </span>MooseX::Declare;
<span style="color: brown;"> 3 </span>
<span style="color: brown;"> 4 </span>class QuestionNode {
<span style="color: brown;"> 5 </span> has <span style="color: magenta;">question </span>=> ( <span style="color: magenta;">is </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">ro</span><span style="color: magenta;">"</span>, <span style="color: magenta;">isa </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Str</span><span style="color: magenta;">"</span>, <span style="color: magenta;">required </span>=> <span style="color: magenta;">1</span> );
<span style="color: brown;"> 6 </span> has [ <span style="color: magenta;">"</span><span style="color: magenta;">yes</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">no</span><span style="color: magenta;">"</span> ] => ( <span style="color: magenta;">is </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">rw</span><span style="color: magenta;">"</span>, <span style="color: magenta;">isa </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Str|QuestionNode</span><span style="color: magenta;">"</span>, <span style="color: magenta;">required </span>=> <span style="color: magenta;">1</span> );
<span style="color: brown;"> 7 </span>}
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span>role AnimalsGame {
<span style="color: brown;">10 </span>
<span style="color: brown;">11 </span> has <span style="color: magenta;">tree </span>=> (
<span style="color: brown;">12 </span> <span style="color: magenta;">is </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">ro</span><span style="color: magenta;">"</span>,
<span style="color: brown;">13 </span> <span style="color: magenta;">isa </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">QuestionNode</span><span style="color: magenta;">"</span>,
<span style="color: brown;">14 </span> <span style="color: magenta;">default </span>=><span style="color: darkcyan;"> </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span>{
<span style="color: brown;">15 </span> QuestionNode-><span style="color: brown;"><b>new</b></span>(
<span style="color: brown;">16 </span> { <span style="color: magenta;">question </span>=> <span style="color: magenta;">'</span><span style="color: magenta;">lives in the water</span><span style="color: magenta;">'</span>, <span style="color: magenta;">no </span>=> <span style="color: magenta;">'</span><span style="color: magenta;">tiger</span><span style="color: magenta;">'</span>, <span style="color: magenta;">yes </span>=> <span style="color: magenta;">'</span><span style="color: magenta;">tiburón</span><span style="color: magenta;">'</span> } );
<span style="color: brown;">17 </span> }
<span style="color: brown;">18 </span> );
<span style="color: brown;">19 </span>
<span style="color: brown;">20 </span> method play {
<span style="color: brown;">21 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$guess</span> = <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->tree</span>;
<span style="color: brown;">22 </span> <span style="color: brown;"><b>my</b></span> ( <span style="color: darkcyan;">$node</span>, <span style="color: darkcyan;">$branch</span> );
<span style="color: brown;">23 </span> <span style="color: brown;"><b>while</b></span> ( <span style="color: brown;"><b>ref</b></span>(<span style="color: darkcyan;">$guess</span>) ) {
<span style="color: brown;">24 </span> <span style="color: darkcyan;">$node</span> = <span style="color: darkcyan;">$guess</span>;
<span style="color: brown;">25 </span> <span style="color: darkcyan;">$branch</span> = <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->yes</span>( <span style="color: darkcyan;">$node</span><span style="color: darkcyan;">->question</span> ) ? <span style="color: magenta;">"</span><span style="color: magenta;">yes</span><span style="color: magenta;">"</span> : <span style="color: magenta;">"</span><span style="color: magenta;">no</span><span style="color: magenta;">"</span>;
<span style="color: brown;">26 </span> <span style="color: darkcyan;">$guess</span> = <span style="color: darkcyan;">$node</span>-><span style="color: darkcyan;">$branch</span>;
<span style="color: brown;">27 </span> }
<span style="color: brown;">28 </span> <span style="color: brown;"><b>return</b></span> <span style="color: brown;"><b>if</b></span> <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->yes</span>(<span style="color: magenta;">"</span><span style="color: magenta;">Is it a(n) </span><span style="color: darkcyan;">$guess</span><span style="color: magenta;">"</span>);
<span style="color: brown;">29 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$animal</span> = <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->prompt</span>(<span style="color: magenta;">"</span><span style="color: magenta;">Animal's name? : </span><span style="color: magenta;">"</span>);
<span style="color: brown;">30 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$diff</span> = <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->prompt</span>(
<span style="color: brown;">31 </span> <span style="color: magenta;">"</span><span style="color: magenta;">A question true for </span><span style="color: darkcyan;">$animal</span><span style="color: magenta;">, but false for </span><span style="color: darkcyan;">$guess</span><span style="color: magenta;">: </span><span style="color: magenta;">"</span>);
<span style="color: brown;">32 </span> <span style="color: darkcyan;">$node</span>-><span style="color: darkcyan;">$branch</span>( QuestionNode-><span style="color: brown;"><b>new</b></span>( { <span style="color: magenta;">question </span>=> <span style="color: darkcyan;">$diff</span>, <span style="color: magenta;">no </span>=> <span style="color: darkcyan;">$guess</span>, <span style="color: magenta;">yes </span>=> <span style="color: darkcyan;">$animal</span> } ) );
<span style="color: brown;">33 </span> }
<span style="color: brown;">34 </span>
<span style="color: brown;">35 </span>}
<span style="color: brown;">36 </span>
<span style="color: brown;">37 </span>role ConsoleGame {
<span style="color: brown;">38 </span> <span style="color: #a020f0;">use </span>Term::ReadLine;
<span style="color: brown;">39 </span> <span style="color: #a020f0;">use </span>IO::Handle;
<span style="color: brown;">40 </span>
<span style="color: brown;">41 </span> has <span style="color: magenta;">title </span>=> ( <span style="color: magenta;">is </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">ro</span><span style="color: magenta;">"</span>, <span style="color: magenta;">isa </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Str</span><span style="color: magenta;">"</span>, <span style="color: magenta;">default </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Animals' game</span><span style="color: magenta;">"</span> );
<span style="color: brown;">42 </span> has <span style="color: magenta;">term </span>=> (
<span style="color: brown;">43 </span> <span style="color: magenta;">is </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">ro</span><span style="color: magenta;">"</span>,
<span style="color: brown;">44 </span> <span style="color: magenta;">isa </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Object</span><span style="color: magenta;">"</span>,
<span style="color: brown;">45 </span> <span style="color: magenta;">lazy_build </span>=> <span style="color: magenta;">1</span>,
<span style="color: brown;">46 </span> <span style="color: magenta;">handles </span>=> { <span style="color: magenta;">prompt </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">readline</span><span style="color: magenta;">"</span> }
<span style="color: brown;">47 </span> );
<span style="color: brown;">48 </span>
<span style="color: brown;">49 </span> method _build_term {
<span style="color: brown;">50 </span> Term::ReadLine-><span style="color: brown;"><b>new</b></span>( <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->title</span> );
<span style="color: brown;">51 </span> }
<span style="color: brown;">52 </span>
<span style="color: brown;">53 </span> method yes(Str <span style="color: darkcyan;">$prompt</span>) {
<span style="color: brown;">54 </span> <span style="color: brown;"><b>while</b></span> (<span style="color: magenta;">1</span>) {
<span style="color: brown;">55 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$answer</span> = <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->prompt</span>(<span style="color: magenta;">"</span><span style="color: darkcyan;">$prompt</span><span style="color: magenta;">? (y/n): </span><span style="color: magenta;">"</span>);
<span style="color: brown;">56 </span> <span style="color: brown;"><b>return</b></span> ( <span style="color: darkcyan;">$2</span> ? <span style="color: magenta;">1</span> : <span style="color: magenta;">0</span> ) <span style="color: brown;"><b>if</b></span> <span style="color: darkcyan;">$answer</span> =~<span style="color: brown;"><b> /</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">*((</span><span style="color: magenta;">yes|y</span><span style="color: slateblue;">)</span><span style="color: magenta;">|</span><span style="color: slateblue;">(</span><span style="color: magenta;">no|n</span><span style="color: slateblue;">))</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">*</span><span style="color: brown;"><b>/i</b></span>;
<span style="color: brown;">57 </span> <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->term</span>->OUT-><span style="color: brown;"><b>print</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">Please answer 'y' or 'n'</span><span style="color: slateblue;">\n</span><span style="color: magenta;">"</span>);
<span style="color: brown;">58 </span> }
<span style="color: brown;">59 </span> }
<span style="color: brown;">60 </span>
<span style="color: brown;">61 </span> method run {
<span style="color: brown;">62 </span> <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->play</span>;
<span style="color: brown;">63 </span> <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->play</span> <span style="color: brown;"><b>while</b></span> <span style="color: darkcyan;">$self</span><span style="color: darkcyan;">->yes</span>(<span style="color: magenta;">"</span><span style="color: magenta;">Do you want to play again</span><span style="color: magenta;">"</span>);
<span style="color: brown;">64 </span> }
<span style="color: brown;">65 </span>}
<span style="color: brown;">66 </span>
<span style="color: brown;">67 </span>class Game with AnimalsGame with ConsoleGame {}
<span style="color: brown;">68 </span>
<span style="color: brown;">69 </span>Game-><span style="color: brown;"><b>new</b></span>->run;
</pre>Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com1tag:blogger.com,1999:blog-699609172043710797.post-25286749231549349072010-01-11T00:45:00.001-04:302010-01-11T03:09:17.227-04:30Programming Style Evolution in Perl[<a href="http://perliscopio.blogspot.com/2010/01/evolucion-del-estilo-en-perl.html">Original Spanish source</a>]<br />
<br />
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.<br />
<br />
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.<br />
<br />
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.<br />
<br />
<h2>Ancient Perl5</h2><br />
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:<br />
<br />
Style 1: Old perl.<br />
<pre><font color="#a52a2a"> 1 </font><font color="#a020f0">#!/usr/bin/env perl</font>
<font color="#a52a2a"> 2 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">prompt </font>{
<font color="#a52a2a"> 3 </font> <font color="#a52a2a"><b>print</b></font> <font color="#008b8b">$_[</font><font color="#ff00ff">0</font><font color="#008b8b">]</font>;
<font color="#a52a2a"> 4 </font> <font color="#008b8b">$line</font> = <>;
<font color="#a52a2a"> 5 </font> <font color="#a52a2a"><b>chomp</b></font> <font color="#008b8b">$line</font>;
<font color="#a52a2a"> 6 </font> <font color="#008b8b">$line</font>;
<font color="#a52a2a"> 7 </font>}
<font color="#a52a2a"> 8 </font>
<font color="#a52a2a"> 9 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">yes </font>{
<font color="#a52a2a">10 </font> prompt(<font color="#ff00ff">"</font><font color="#008b8b">$_[</font><font color="#ff00ff">0</font><font color="#008b8b">]</font><font color="#ff00ff">? (y/n): </font><font color="#ff00ff">"</font>) =~<font color="#a52a2a"><b> /</b></font><font color="#ff00ff">^</font><font color="#6a5acd">\s</font><font color="#6a5acd">*</font><font color="#ff00ff">y</font><font color="#a52a2a"><b>/i</b></font>;
<font color="#a52a2a">11 </font>}
<font color="#a52a2a">12 </font>
<font color="#a52a2a">13 </font><font color="#008b8b">$question</font> = <font color="#008b8b">$root</font> = <font color="#ff00ff">"</font><font color="#ff00ff">lives in the water</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">14 </font><font color="#008b8b">%tree</font> = ( <font color="#008b8b">$root</font> => [ <font color="#ff00ff">'</font><font color="#ff00ff">tiger</font><font color="#ff00ff">'</font>, <font color="#ff00ff">'</font><font color="#ff00ff">shark</font><font color="#ff00ff">'</font> ] );
<font color="#a52a2a">15 </font><font color="#a52a2a"><b>do</b></font> {
<font color="#a52a2a">16 </font> {
<font color="#a52a2a">17 </font> <font color="#008b8b">$branch</font> = yes(<font color="#008b8b">$question</font>);
<font color="#a52a2a">18 </font> <font color="#008b8b">$guess</font> = <font color="#008b8b">$tree{$question}[$branch]</font>;
<font color="#a52a2a">19 </font> <font color="#008b8b">$question</font> = <font color="#008b8b">$guess</font>, <font color="#a52a2a"><b>redo</b></font> <font color="#a52a2a"><b>if</b></font> <font color="#008b8b">$tree{$guess}</font>;
<font color="#a52a2a">20 </font> <font color="#008b8b">$question</font> = <font color="#008b8b">$root</font>, <font color="#a52a2a"><b>next</b></font> <font color="#a52a2a"><b>if</b></font> yes(<font color="#ff00ff">"</font><font color="#ff00ff">Is it a(n) </font><font color="#008b8b">$guess</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">21 </font> <font color="#008b8b">$animal</font> = prompt(<font color="#ff00ff">"</font><font color="#ff00ff">Animal's name? : </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">22 </font> <font color="#008b8b">$diff</font> = prompt( <font color="#ff00ff">"</font><font color="#ff00ff">A question true for </font><font color="#008b8b">$animal</font><font color="#ff00ff">"</font> .
<font color="#a52a2a">23 </font> <font color="#ff00ff">"</font><font color="#ff00ff">, but false for </font><font color="#008b8b">$guess</font><font color="#ff00ff">: </font><font color="#ff00ff">"</font> );
<font color="#a52a2a">24 </font> <font color="#008b8b">$tree{$diff}</font> = [ <font color="#008b8b">$tree{$question}[$branch]</font>, <font color="#008b8b">$animal</font> ];
<font color="#a52a2a">25 </font> <font color="#008b8b">$tree{$question}[$branch]</font> = <font color="#008b8b">$diff</font>;
<font color="#a52a2a">26 </font> <font color="#008b8b">$question</font> = <font color="#008b8b">$root</font>
<font color="#a52a2a">27 </font> }
<font color="#a52a2a">28 </font>} <font color="#a52a2a"><b>while</b></font> yes(<font color="#ff00ff">"</font><font color="#ff00ff">Do you want to play again</font><font color="#ff00ff">"</font>);
</pre><br />
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:<br />
<br />
Style 2: Golf<br />
<pre><font color="#a52a2a">1 </font><font color="#a020f0">#!/usr/bin/env perl</font>
<font color="#a52a2a">2 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">p{print$_[</font><font color="#008b8b">0]</font>;<font color="#008b8b">$l</font>=<>;<font color="#a52a2a"><b>chomp</b></font><font color="#008b8b">$l</font>;<font color="#008b8b">$l</font>}<font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">a{p(</font><font color="#008b8b">"$</font><font color="#008b8b">_[</font><font color="#008b8b">0]? </font><font color="#008b8b">(y/n)</font><font color="#008b8b">: ")=~/^\</font><font color="#008b8b">s*y/i}</font><font color="#008b8b">$</font><font color="#008b8b">q=</font>
<font color="#a52a2a">3 </font><font color="#008b8b">$</font><font color="#008b8b">s=</font><font color="#008b8b">"</font><font color="#008b8b">lives in the water"</font>;<font color="#008b8b">%t</font>=(<font color="#008b8b">$s</font>=>[<font color="#ff00ff">"</font><font color="#ff00ff">tiger</font><font color="#ff00ff">"</font>,<font color="#ff00ff">"</font><font color="#ff00ff">shark</font><font color="#ff00ff">"</font>]);<font color="#a52a2a"><b>do</b></font> {{<font color="#008b8b">$v</font>=a(<font color="#008b8b">$q</font>);<font color="#008b8b">$a</font>=<font color="#008b8b">$t{$q}[$v]</font>;
<font color="#a52a2a">4 </font><font color="#008b8b">$q</font>=<font color="#008b8b">$a</font>,<font color="#a52a2a"><b>redo</b></font> <font color="#a52a2a"><b>if</b></font><font color="#008b8b">$t{$a}</font>;<font color="#008b8b">$q</font>=<font color="#008b8b">$s</font>,<font color="#a52a2a"><b>next</b></font> <font color="#a52a2a"><b>if</b></font> a<font color="#ff00ff">"</font><font color="#ff00ff">Is it a(n) </font><font color="#008b8b">$a</font><font color="#ff00ff">"</font>;<font color="#008b8b">$n</font>=p<font color="#ff00ff">"</font><font color="#ff00ff">Animal's name? : </font><font color="#ff00ff">"</font>;
<font color="#a52a2a">5 </font><font color="#008b8b">$o</font>=p<font color="#ff00ff">"</font><font color="#ff00ff">A question true for </font><font color="#008b8b">$n</font><font color="#ff00ff">, but false for </font><font color="#008b8b">$a</font><font color="#ff00ff">: </font><font color="#ff00ff">"</font>;<font color="#008b8b">$t{$o}</font>
<font color="#a52a2a">6 </font>=[<font color="#008b8b">$t{$q}[$v]</font>,<font color="#008b8b">$n</font>];<font color="#008b8b">$t{$q}[$v]</font>=<font color="#008b8b">$o</font>;<font color="#008b8b">$q</font>=<font color="#008b8b">$s</font>}}<font color="#a52a2a"><b>while</b></font> a<font color="#ff00ff">"</font><font color="#ff00ff">Do you want to play again</font><font color="#ff00ff">"</font>;
</pre><br />
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:<br />
<br />
Style 3: Succinct<br />
<pre><font color="#a52a2a"> 1 </font><font color="#a020f0">#!/usr/bin/env perl</font>
<font color="#a52a2a"> 2 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">p </font>{ <font color="#a52a2a"><b>print</b></font> <font color="#008b8b">$_[</font><font color="#ff00ff">0</font><font color="#008b8b">]</font>; <font color="#008b8b">$l</font> = <>; <font color="#a52a2a"><b>chomp</b></font> <font color="#008b8b">$l</font>; <font color="#008b8b">$l</font> }
<font color="#a52a2a"> 3 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">a </font>{ p(<font color="#ff00ff">"</font><font color="#008b8b">$_[</font><font color="#ff00ff">0</font><font color="#008b8b">]</font><font color="#ff00ff">? (y/n): </font><font color="#ff00ff">"</font>) =~<font color="#a52a2a"><b> /</b></font><font color="#ff00ff">^</font><font color="#6a5acd">\s</font><font color="#6a5acd">*</font><font color="#ff00ff">y</font><font color="#a52a2a"><b>/i</b></font> }
<font color="#a52a2a"> 4 </font><font color="#008b8b">$q</font> = <font color="#008b8b">$s</font> = <font color="#ff00ff">"</font><font color="#ff00ff">lives in the water</font><font color="#ff00ff">"</font>;
<font color="#a52a2a"> 5 </font><font color="#008b8b">%t</font> = ( <font color="#008b8b">$s</font> => [ <font color="#ff00ff">"</font><font color="#ff00ff">tiger</font><font color="#ff00ff">"</font>, <font color="#ff00ff">"</font><font color="#ff00ff">shark</font><font color="#ff00ff">"</font> ] );
<font color="#a52a2a"> 6 </font><font color="#a52a2a"><b>do</b></font> {
<font color="#a52a2a"> 7 </font> {
<font color="#a52a2a"> 8 </font> <font color="#008b8b">$v</font> = a(<font color="#008b8b">$q</font>);
<font color="#a52a2a"> 9 </font> <font color="#008b8b">$a</font> = <font color="#008b8b">$t{$q}[$v]</font>;
<font color="#a52a2a">10 </font> <font color="#008b8b">$q</font> = <font color="#008b8b">$a</font>, <font color="#a52a2a"><b>redo</b></font> <font color="#a52a2a"><b>if</b></font> <font color="#008b8b">$t{$a}</font>;
<font color="#a52a2a">11 </font> <font color="#008b8b">$q</font> = <font color="#008b8b">$s</font>, <font color="#a52a2a"><b>next</b></font> <font color="#a52a2a"><b>if</b></font> a(<font color="#ff00ff">"</font><font color="#ff00ff">Is it a(n) </font><font color="#008b8b">$a</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">12 </font> <font color="#008b8b">$n</font> = p(<font color="#ff00ff">"</font><font color="#ff00ff">Animal's name? : </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">13 </font> <font color="#008b8b">$o</font> = p(<font color="#ff00ff">"</font><font color="#ff00ff">A question true for </font><font color="#008b8b">$n</font><font color="#ff00ff">, but false for </font><font color="#008b8b">$a</font><font color="#ff00ff">: </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">14 </font> <font color="#008b8b">$t{$o}</font> = [ <font color="#008b8b">$t{$q}[$v]</font>, <font color="#008b8b">$n</font> ];
<font color="#a52a2a">15 </font> <font color="#008b8b">$t{$q}[$v]</font> = <font color="#008b8b">$o</font>;
<font color="#a52a2a">16 </font> <font color="#008b8b">$q</font> = <font color="#008b8b">$s</font>
<font color="#a52a2a">17 </font> }
<font color="#a52a2a">18 </font>} <font color="#a52a2a"><b>while</b></font> a(<font color="#ff00ff">"</font><font color="#ff00ff">Do you want to play again</font><font color="#ff00ff">"</font>);
</pre><br />
<br />
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.<br />
<br />
<h2>Procedures and DSL</h2><br />
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.<br />
<br />
Style 4: Procedural/DSL<br />
<pre><font color="#a52a2a"> 1 </font><font color="#a020f0">#!/usr/bin/env perl</font>
<font color="#a52a2a"> 2 </font><font color="#a020f0">use </font>Term::ReadLine;
<font color="#a52a2a"> 3 </font>
<font color="#a52a2a"> 4 </font><font color="#a020f0">use strict</font>;
<font color="#a52a2a"> 5 </font>
<font color="#a52a2a"> 6 </font><font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$term</font> = <font color="#a52a2a"><b>new</b></font> Term::ReadLine <font color="#ff00ff">"</font><font color="#ff00ff">Animals' game</font><font color="#ff00ff">"</font>;
<font color="#a52a2a"> 7 </font>
<font color="#a52a2a"> 8 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">prompt(</font><font color="#008b8b">$) </font>{ <font color="#008b8b">$term</font><font color="#008b8b">->readline</font>(<font color="#a52a2a"><b>shift</b></font>) }
<font color="#a52a2a"> 9 </font>
<font color="#a52a2a">10 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">yes(</font><font color="#008b8b">$) </font>{
<font color="#a52a2a">11 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$prompt</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">12 </font> <font color="#a52a2a"><b>while</b></font> ( <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$answer</font> = prompt <font color="#ff00ff">"</font><font color="#008b8b">$prompt</font><font color="#ff00ff">? (y/n): </font><font color="#ff00ff">"</font> ) {
<font color="#a52a2a">13 </font> <font color="#a52a2a"><b>return</b></font> <font color="#008b8b">$answer</font> =~<font color="#a52a2a"><b> /</b></font><font color="#ff00ff">^</font><font color="#6a5acd">\s</font><font color="#6a5acd">*((</font><font color="#ff00ff">yes|y</font><font color="#6a5acd">)</font><font color="#ff00ff">|</font><font color="#6a5acd">(</font><font color="#ff00ff">no|n</font><font color="#6a5acd">))</font><font color="#6a5acd">\s</font><font color="#6a5acd">*</font><font color="#a52a2a"><b>/i</b></font>;
<font color="#a52a2a">14 </font> <font color="#a52a2a"><b>print</b></font> { <font color="#008b8b">$term</font><font color="#008b8b">->OUT</font> } <font color="#ff00ff">"</font><font color="#ff00ff">Please answer 'y' or 'n'</font><font color="#6a5acd">\n</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">15 </font> }
<font color="#a52a2a">16 </font>}
<font color="#a52a2a">17 </font>
<font color="#a52a2a">18 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">play </font>{
<font color="#a52a2a">19 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$guess</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">20 </font> <font color="#a52a2a"><b>my</b></font> (<font color="#008b8b">$node</font>, <font color="#008b8b">$branch</font>);
<font color="#a52a2a">21 </font> <font color="#a52a2a"><b>while</b></font> ( <font color="#a52a2a"><b>ref</b></font> <font color="#008b8b">$guess</font> ) {
<font color="#a52a2a">22 </font> <font color="#008b8b">$node</font> = <font color="#008b8b">$guess</font>;
<font color="#a52a2a">23 </font> <font color="#008b8b">$branch</font> = yes <font color="#008b8b">$node</font><font color="#008b8b">->{</font><font color="#ff00ff">question</font><font color="#008b8b">}</font>;
<font color="#a52a2a">24 </font> <font color="#008b8b">$guess</font> = <font color="#008b8b">$node</font><font color="#008b8b">->{</font><font color="#ff00ff">branches</font><font color="#008b8b">}</font><font color="#008b8b">[$branch]</font>;
<font color="#a52a2a">25 </font> }
<font color="#a52a2a">26 </font> <font color="#a52a2a"><b>return</b></font> <font color="#a52a2a"><b>if</b></font> yes <font color="#ff00ff">"</font><font color="#ff00ff">Is it a(n) </font><font color="#008b8b">$guess</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">27 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$animal</font> = prompt <font color="#ff00ff">"</font><font color="#ff00ff">Animal's name? : </font><font color="#ff00ff">"</font>;
<font color="#a52a2a">28 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$diff</font> = prompt <font color="#ff00ff">"</font><font color="#ff00ff">A question true for </font><font color="#008b8b">$animal</font><font color="#ff00ff">"</font> .
<font color="#a52a2a">29 </font> <font color="#ff00ff">"</font><font color="#ff00ff">, but false for </font><font color="#008b8b">$guess</font><font color="#ff00ff">: </font><font color="#ff00ff">"</font>;
<font color="#a52a2a">30 </font> <font color="#008b8b">$node</font><font color="#008b8b">->{</font><font color="#ff00ff">branches</font><font color="#008b8b">}</font><font color="#008b8b">[$branch]</font> = { <font color="#ff00ff">question </font>=> <font color="#008b8b">$diff</font>, <font color="#ff00ff">branches </font>=> [ <font color="#008b8b">$guess</font>, <font color="#008b8b">$animal</font> ] };
<font color="#a52a2a">31 </font>}
<font color="#a52a2a">32 </font>
<font color="#a52a2a">33 </font><font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$tree</font> = { <font color="#ff00ff">question </font>=> <font color="#ff00ff">'</font><font color="#ff00ff">lives in the water</font><font color="#ff00ff">'</font>, <font color="#ff00ff">branches </font>=> [ <font color="#ff00ff">'</font><font color="#ff00ff">tiger</font><font color="#ff00ff">'</font>, <font color="#ff00ff">'</font><font color="#ff00ff">shark</font><font color="#ff00ff">'</font> ] };
<font color="#a52a2a">34 </font>play <font color="#008b8b">$tree</font>;
<font color="#a52a2a">35 </font>play <font color="#008b8b">$tree</font> <font color="#a52a2a"><b>while</b></font> yes <font color="#ff00ff">"</font><font color="#ff00ff">Do you want to play again</font><font color="#ff00ff">"</font>;
</pre><br />
<br />
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.<br />
<br />
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.<br />
<br />
<h2>Hand made classes</h2><br />
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:<br />
<br />
Style 5: Hand made classes<br />
<br />
game.pl:<br />
<pre><font color="#a52a2a"> 1 </font><font color="#a020f0">#!/usr/bin/env perl</font>
<font color="#a52a2a"> 2 </font><font color="#a020f0">use </font>QuestionNode;
<font color="#a52a2a"> 3 </font><font color="#a020f0">use </font>Term::ReadLine;
<font color="#a52a2a"> 4 </font><font color="#a020f0">use </font>IO::Handle;
<font color="#a52a2a"> 5 </font>
<font color="#a52a2a"> 6 </font><font color="#a020f0">use strict</font>;
<font color="#a52a2a"> 7 </font>
<font color="#a52a2a"> 8 </font><font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$term</font> = Term::ReadLine-><font color="#a52a2a"><b>new</b></font>(<font color="#ff00ff">"</font><font color="#ff00ff">Animals' game</font><font color="#ff00ff">"</font>);
<font color="#a52a2a"> 9 </font>
<font color="#a52a2a">10 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">prompt(</font><font color="#008b8b">$) </font>{ <font color="#008b8b">$term</font><font color="#008b8b">->readline</font>(<font color="#a52a2a"><b>shift</b></font>) }
<font color="#a52a2a">11 </font>
<font color="#a52a2a">12 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">yes(</font><font color="#008b8b">$) </font>{
<font color="#a52a2a">13 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$prompt</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">14 </font> <font color="#a52a2a"><b>while</b></font> (<font color="#ff00ff">1</font>) {
<font color="#a52a2a">15 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$answer</font> = prompt(<font color="#ff00ff">"</font><font color="#008b8b">$prompt</font><font color="#ff00ff">? (y/n): </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">16 </font> <font color="#a52a2a"><b>return</b></font> ( <font color="#008b8b">$2</font> ? <font color="#ff00ff">1</font> : <font color="#ff00ff">0</font> ) <font color="#a52a2a"><b>if</b></font> <font color="#008b8b">$answer</font> =~<font color="#a52a2a"><b> /</b></font><font color="#ff00ff">^</font><font color="#6a5acd">\s</font><font color="#6a5acd">*((</font><font color="#ff00ff">yes|y</font><font color="#6a5acd">)</font><font color="#ff00ff">|</font><font color="#6a5acd">(</font><font color="#ff00ff">no|n</font><font color="#6a5acd">))</font><font color="#6a5acd">\s</font><font color="#6a5acd">*</font><font color="#a52a2a"><b>/i</b></font>;
<font color="#a52a2a">17 </font> <font color="#008b8b">$term</font><font color="#008b8b">->OUT</font>-><font color="#a52a2a"><b>print</b></font>(<font color="#ff00ff">"</font><font color="#ff00ff">Please answer 'y' or 'n'</font><font color="#6a5acd">\n</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">18 </font> }
<font color="#a52a2a">19 </font>}
<font color="#a52a2a">20 </font>
<font color="#a52a2a">21 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">play </font>{
<font color="#a52a2a">22 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$guess</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">23 </font> <font color="#a52a2a"><b>my</b></font> ( <font color="#008b8b">$node</font>, <font color="#008b8b">$branch</font> );
<font color="#a52a2a">24 </font> <font color="#a52a2a"><b>while</b></font> ( <font color="#a52a2a"><b>ref</b></font> <font color="#008b8b">$guess</font> ) {
<font color="#a52a2a">25 </font> <font color="#008b8b">$node</font> = <font color="#008b8b">$guess</font>;
<font color="#a52a2a">26 </font> <font color="#008b8b">$branch</font> = yes <font color="#008b8b">$node</font><font color="#008b8b">->question</font> ? <font color="#ff00ff">"</font><font color="#ff00ff">yes</font><font color="#ff00ff">"</font> : <font color="#ff00ff">"</font><font color="#ff00ff">no</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">27 </font> <font color="#008b8b">$guess</font> = <font color="#008b8b">$node</font>-><font color="#008b8b">$branch</font>;
<font color="#a52a2a">28 </font> }
<font color="#a52a2a">29 </font> <font color="#a52a2a"><b>return</b></font> <font color="#a52a2a"><b>if</b></font> yes <font color="#ff00ff">"</font><font color="#ff00ff">Is it a(n) </font><font color="#008b8b">$guess</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">30 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$animal</font> = prompt <font color="#ff00ff">"</font><font color="#ff00ff">Animal's name? : </font><font color="#ff00ff">"</font>;
<font color="#a52a2a">31 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$diff</font> = prompt
<font color="#a52a2a">32 </font> <font color="#ff00ff">"</font><font color="#ff00ff">A question true for </font><font color="#008b8b">$animal</font><font color="#ff00ff">, but false for </font><font color="#008b8b">$guess</font><font color="#ff00ff">: </font><font color="#ff00ff">"</font>;
<font color="#a52a2a">33 </font> <font color="#008b8b">$node</font>-><font color="#008b8b">$branch</font>( QuestionNode-><font color="#a52a2a"><b>new</b></font>( <font color="#008b8b">$diff</font>, <font color="#008b8b">$guess</font>, <font color="#008b8b">$animal</font> ) );
<font color="#a52a2a">34 </font>}
<font color="#a52a2a">35 </font>
<font color="#a52a2a">36 </font><font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$tree</font> = <font color="#a52a2a"><b>new</b></font> QuestionNode( <font color="#ff00ff">'</font><font color="#ff00ff">lives in the water</font><font color="#ff00ff">'</font>, <font color="#ff00ff">'</font><font color="#ff00ff">tiger</font><font color="#ff00ff">'</font>, <font color="#ff00ff">'</font><font color="#ff00ff">shark</font><font color="#ff00ff">'</font> );
<font color="#a52a2a">37 </font>play <font color="#008b8b">$tree</font>;
<font color="#a52a2a">38 </font>play <font color="#008b8b">$tree</font> <font color="#a52a2a"><b>while</b></font> yes <font color="#ff00ff">"</font><font color="#ff00ff">Do you want to play again</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">39 </font>
</pre><br />
QuestionNode.pm:<br />
<pre><font color="#a52a2a"> 1 </font><font color="#a52a2a"><b>package</b></font><font color="#2e8b57"><b> QuestionNode;</b></font>
<font color="#a52a2a"> 2 </font><font color="#a020f0">use </font>Carp;
<font color="#a52a2a"> 3 </font><font color="#a020f0">use strict</font>;
<font color="#a52a2a"> 4 </font>
<font color="#a52a2a"> 5 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">new </font>{
<font color="#a52a2a"> 6 </font> <font color="#a52a2a"><b>my</b></font> ( <font color="#008b8b">$class</font>, <font color="#008b8b">$question</font>, <font color="#008b8b">$no</font>, <font color="#008b8b">$yes</font> ) = <font color="#008b8b">@_</font>;
<font color="#a52a2a"> 7 </font> <font color="#a52a2a"><b>bless</b></font> { <font color="#ff00ff">question </font>=> <font color="#008b8b">$question</font>, <font color="#ff00ff">no </font>=> <font color="#008b8b">$no</font>, <font color="#ff00ff">yes </font>=> <font color="#008b8b">$yes</font> }, <font color="#a52a2a"><b>ref</b></font> <font color="#008b8b">$class</font> || <font color="#008b8b">$class</font>;
<font color="#a52a2a"> 8 </font>}
<font color="#a52a2a"> 9 </font>
<font color="#a52a2a">10 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">question </font>{
<font color="#a52a2a">11 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">12 </font> <font color="#a52a2a"><b>return</b></font> <font color="#008b8b">$self</font><font color="#008b8b">->{</font><font color="#ff00ff">question</font><font color="#008b8b">}</font> <font color="#a52a2a"><b>unless</b></font> <font color="#008b8b">@_</font>;
<font color="#a52a2a">13 </font> croak <font color="#ff00ff">"</font><font color="#ff00ff">question is a read only attribute</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">14 </font>}
<font color="#a52a2a">15 </font>
<font color="#a52a2a">16 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">yes </font>{
<font color="#a52a2a">17 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">18 </font> <font color="#a52a2a"><b>return</b></font> <font color="#008b8b">$self</font><font color="#008b8b">->{</font><font color="#ff00ff">yes</font><font color="#008b8b">}</font> <font color="#a52a2a"><b>unless</b></font> <font color="#008b8b">@_</font>;
<font color="#a52a2a">19 </font> <font color="#a52a2a"><b>return</b></font> <font color="#008b8b">$self</font><font color="#008b8b">->{</font><font color="#ff00ff">yes</font><font color="#008b8b">}</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">20 </font>}
<font color="#a52a2a">21 </font>
<font color="#a52a2a">22 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">no </font>{
<font color="#a52a2a">23 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">24 </font> <font color="#a52a2a"><b>return</b></font> <font color="#008b8b">$self</font><font color="#008b8b">->{</font><font color="#ff00ff">no</font><font color="#008b8b">}</font> <font color="#a52a2a"><b>unless</b></font> <font color="#008b8b">@_</font>;
<font color="#a52a2a">25 </font> <font color="#a52a2a"><b>return</b></font> <font color="#008b8b">$self</font><font color="#008b8b">->{</font><font color="#ff00ff">no</font><font color="#008b8b">}</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">26 </font>}
<font color="#a52a2a">27 </font>
<font color="#a52a2a">28 </font><font color="#ff00ff">1</font>;
</pre><br />
The example is still using the prototypes and the indirect syntax for some things.<br />
<br />
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.<br />
<br />
<h2>Class Assistants</h2><br />
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.<br />
<br />
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:<br />
<br />
Style 6: Class Assistants<br />
<br />
game.pl:<br />
<pre><font color="#a52a2a">1 </font><font color="#a020f0">#!/usr/bin/env perl</font>
<font color="#a52a2a">2 </font><font color="#a020f0">use </font>AnimalsGame;
<font color="#a52a2a">3 </font>AnimalsGame-><font color="#a52a2a"><b>new</b></font>->run;
</pre><br />
AnimalsGame.pm:<br />
<pre><font color="#a52a2a"> 1 </font><font color="#a52a2a"><b>package</b></font><font color="#2e8b57"><b> AnimalsGame;</b></font>
<font color="#a52a2a"> 2 </font><font color="#a020f0">use </font>QuestionNode;
<font color="#a52a2a"> 3 </font><font color="#a020f0">use </font>Term::ReadLine;
<font color="#a52a2a"> 4 </font><font color="#a020f0">use </font>IO::Handle;
<font color="#a52a2a"> 5 </font><font color="#a020f0">use base</font> <font color="#ff00ff">"</font><font color="#ff00ff">Class::Accessor</font><font color="#ff00ff">"</font>;
<font color="#a52a2a"> 6 </font><font color="#a020f0">use strict</font>;
<font color="#a52a2a"> 7 </font>
<font color="#a52a2a"> 8 </font>__PACKAGE__->mk_ro_accessors(<font color="#ff00ff">qw(</font><font color="#ff00ff">tree term</font><font color="#ff00ff">)</font>);
<font color="#a52a2a"> 9 </font>
<font color="#a52a2a">10 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">prompt </font>{
<font color="#a52a2a">11 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">12 </font> <font color="#008b8b">$self</font><font color="#008b8b">->term</font>-><font color="#a52a2a"><b>readline</b></font>(<font color="#a52a2a"><b>shift</b></font>);
<font color="#a52a2a">13 </font>}
<font color="#a52a2a">14 </font>
<font color="#a52a2a">15 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">yes </font>{
<font color="#a52a2a">16 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">17 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$prompt</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">18 </font> <font color="#a52a2a"><b>while</b></font> (<font color="#ff00ff">1</font>) {
<font color="#a52a2a">19 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$answer</font> = <font color="#008b8b">$self</font><font color="#008b8b">->prompt</font>(<font color="#ff00ff">"</font><font color="#008b8b">$prompt</font><font color="#ff00ff">? (y/n): </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">20 </font> <font color="#a52a2a"><b>return</b></font> ( <font color="#008b8b">$2</font> ? <font color="#ff00ff">1</font> : <font color="#ff00ff">0</font> ) <font color="#a52a2a"><b>if</b></font> <font color="#008b8b">$answer</font> =~<font color="#a52a2a"><b> /</b></font><font color="#ff00ff">^</font><font color="#6a5acd">\s</font><font color="#6a5acd">*((</font><font color="#ff00ff">yes|y</font><font color="#6a5acd">)</font><font color="#ff00ff">|</font><font color="#6a5acd">(</font><font color="#ff00ff">no|n</font><font color="#6a5acd">))</font><font color="#6a5acd">\s</font><font color="#6a5acd">*</font><font color="#a52a2a"><b>/i</b></font>;
<font color="#a52a2a">21 </font> <font color="#008b8b">$self</font><font color="#008b8b">->term</font>->OUT-><font color="#a52a2a"><b>print</b></font>(<font color="#ff00ff">"</font><font color="#ff00ff">Please answer 'y' or 'n'</font><font color="#6a5acd">\n</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">22 </font> }
<font color="#a52a2a">23 </font>}
<font color="#a52a2a">24 </font>
<font color="#a52a2a">25 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">play </font>{
<font color="#a52a2a">26 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">27 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$guess</font> = <font color="#008b8b">$self</font><font color="#008b8b">->tree</font>;
<font color="#a52a2a">28 </font> <font color="#a52a2a"><b>my</b></font> ( <font color="#008b8b">$node</font>, <font color="#008b8b">$branch</font> );
<font color="#a52a2a">29 </font> <font color="#a52a2a"><b>while</b></font> ( <font color="#a52a2a"><b>ref</b></font> <font color="#008b8b">$guess</font> ) {
<font color="#a52a2a">30 </font> <font color="#008b8b">$node</font> = <font color="#008b8b">$guess</font>;
<font color="#a52a2a">31 </font> <font color="#008b8b">$branch</font> = <font color="#008b8b">$self</font><font color="#008b8b">->yes</font>( <font color="#008b8b">$node</font><font color="#008b8b">->question</font> ) ? <font color="#ff00ff">"</font><font color="#ff00ff">yes</font><font color="#ff00ff">"</font> : <font color="#ff00ff">"</font><font color="#ff00ff">no</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">32 </font> <font color="#008b8b">$guess</font> = <font color="#008b8b">$node</font>-><font color="#008b8b">$branch</font>;
<font color="#a52a2a">33 </font> }
<font color="#a52a2a">34 </font> <font color="#a52a2a"><b>return</b></font> <font color="#a52a2a"><b>if</b></font> <font color="#008b8b">$self</font><font color="#008b8b">->yes</font>(<font color="#ff00ff">"</font><font color="#ff00ff">Is it a(n) </font><font color="#008b8b">$guess</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">35 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$animal</font> = <font color="#008b8b">$self</font><font color="#008b8b">->prompt</font>(<font color="#ff00ff">"</font><font color="#ff00ff">Animal's name? : </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">36 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$diff</font> = <font color="#008b8b">$self</font><font color="#008b8b">->prompt</font>(
<font color="#a52a2a">37 </font> <font color="#ff00ff">"</font><font color="#ff00ff">A question true for </font><font color="#008b8b">$animal</font><font color="#ff00ff">, but false for </font><font color="#008b8b">$guess</font><font color="#ff00ff">: </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">38 </font> <font color="#008b8b">$node</font>-><font color="#008b8b">$branch</font>( QuestionNode-><font color="#a52a2a"><b>new</b></font>(
<font color="#a52a2a">39 </font> { <font color="#ff00ff">question </font>=> <font color="#008b8b">$diff</font>, <font color="#ff00ff">no </font>=> <font color="#008b8b">$guess</font>, <font color="#ff00ff">yes </font>=> <font color="#008b8b">$animal</font> } ) );
<font color="#a52a2a">40 </font>}
<font color="#a52a2a">41 </font>
<font color="#a52a2a">42 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">new </font>{
<font color="#a52a2a">43 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$class</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">44 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$opt</font> = <font color="#a52a2a"><b>shift</b></font> || {};
<font color="#a52a2a">45 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$title</font> = <font color="#008b8b">$opt</font><font color="#008b8b">->{</font><font color="#ff00ff">title</font><font color="#008b8b">}</font> || <font color="#ff00ff">"</font><font color="#ff00ff">Animals' game</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">46 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$term</font> = <font color="#008b8b">$opt</font><font color="#008b8b">->{</font><font color="#ff00ff">term</font><font color="#008b8b">}</font> || Term::ReadLine-><font color="#a52a2a"><b>new</b></font>(<font color="#008b8b">$title</font>);
<font color="#a52a2a">47 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$tree</font> = <font color="#008b8b">$opt</font><font color="#008b8b">->{</font><font color="#ff00ff">tree</font><font color="#008b8b">}</font> || QuestionNode-><font color="#a52a2a"><b>new</b></font>(
<font color="#a52a2a">48 </font> { <font color="#ff00ff">question </font>=> <font color="#ff00ff">'</font><font color="#ff00ff">lives in the water</font><font color="#ff00ff">'</font>, <font color="#ff00ff">no </font>=> <font color="#ff00ff">'</font><font color="#ff00ff">tiger</font><font color="#ff00ff">'</font>, <font color="#ff00ff">yes </font>=> <font color="#ff00ff">'</font><font color="#ff00ff">shark</font><font color="#ff00ff">'</font> } );
<font color="#a52a2a">49 </font> <font color="#a52a2a"><b>return</b></font> <font color="#008b8b">$class</font><font color="#008b8b">->SUPER</font>::<font color="#a52a2a"><b>new</b></font>( { <font color="#ff00ff">tree </font>=> <font color="#008b8b">$tree</font>, <font color="#ff00ff">term </font>=> <font color="#008b8b">$term</font> } );
<font color="#a52a2a">50 </font>}
<font color="#a52a2a">51 </font>
<font color="#a52a2a">52 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">run </font>{
<font color="#a52a2a">53 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">54 </font> <font color="#008b8b">$self</font><font color="#008b8b">->play</font>;
<font color="#a52a2a">55 </font> <font color="#008b8b">$self</font><font color="#008b8b">->play</font> <font color="#a52a2a"><b>while</b></font> <font color="#008b8b">$self</font><font color="#008b8b">->yes</font>(<font color="#ff00ff">"</font><font color="#ff00ff">Do you want to play again</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">56 </font>}
<font color="#a52a2a">57 </font>
<font color="#a52a2a">58 </font><font color="#ff00ff">1</font>;
</pre><br />
QuestionNode.pm:<br />
<pre><font color="#a52a2a">1 </font><font color="#a52a2a"><b>package</b></font><font color="#2e8b57"><b> QuestionNode;</b></font>
<font color="#a52a2a">2 </font><font color="#a020f0">use base</font> <font color="#ff00ff">"</font><font color="#ff00ff">Class::Accessor</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">3 </font><font color="#a020f0">use strict</font>;
<font color="#a52a2a">4 </font>
<font color="#a52a2a">5 </font>__PACKAGE__->mk_ro_accessors(<font color="#ff00ff">"</font><font color="#ff00ff">question</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">6 </font>__PACKAGE__->mk_accessors(<font color="#ff00ff">"</font><font color="#ff00ff">yes</font><font color="#ff00ff">"</font>, <font color="#ff00ff">"</font><font color="#ff00ff">no</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">7 </font>
<font color="#a52a2a">8 </font><font color="#ff00ff">1</font>;
</pre><br />
The OOP support tools caught the programmers attention and Perl programs were made easier to understand and write robustly.<br />
<br />
<h2>Moose</h2><br />
This system is the last word in Perl OOP.<br />
<br />
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.<br />
<br />
Style 7: Moose with multiple inheritance<br />
<br />
game.pl:<br />
<pre><font color="#a52a2a"> 1 </font><font color="#a020f0">#!/usr/bin/env perl</font>
<font color="#a52a2a"> 2 </font><font color="#a52a2a"><b>package</b></font><font color="#2e8b57"><b> Game;</b></font>
<font color="#a52a2a"> 3 </font><font color="#a020f0">use </font>Moose;
<font color="#a52a2a"> 4 </font>
<font color="#a52a2a"> 5 </font>extends <font color="#ff00ff">qw(</font><font color="#ff00ff">AnimalsGame ConsoleGame</font><font color="#ff00ff">)</font>;
<font color="#a52a2a"> 6 </font>
<font color="#a52a2a"> 7 </font>__PACKAGE__->meta->make_immutable;
<font color="#a52a2a"> 8 </font><font color="#a020f0">no </font>Moose;
<font color="#a52a2a"> 9 </font>
<font color="#a52a2a">10 </font>Game-><font color="#a52a2a"><b>new</b></font>->run;
</pre><br />
AnimalsGame.pm:<br />
<pre><font color="#a52a2a"> 1 </font><font color="#a52a2a"><b>package</b></font><font color="#2e8b57"><b> AnimalsGame;</b></font>
<font color="#a52a2a"> 2 </font><font color="#a020f0">use </font>Moose;
<font color="#a52a2a"> 3 </font><font color="#a020f0">use </font>QuestionNode;
<font color="#a52a2a"> 4 </font>
<font color="#a52a2a"> 5 </font>has <font color="#ff00ff">tree </font>=> (
<font color="#a52a2a"> 6 </font> <font color="#ff00ff">is </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">ro</font><font color="#ff00ff">"</font>,
<font color="#a52a2a"> 7 </font> <font color="#ff00ff">isa </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">QuestionNode</font><font color="#ff00ff">"</font>,
<font color="#a52a2a"> 8 </font> <font color="#ff00ff">default </font>=><font color="#008b8b"> </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font>{
<font color="#a52a2a"> 9 </font> QuestionNode-><font color="#a52a2a"><b>new</b></font>(
<font color="#a52a2a">10 </font> { <font color="#ff00ff">question </font>=> <font color="#ff00ff">'</font><font color="#ff00ff">lives in the water</font><font color="#ff00ff">'</font>, <font color="#ff00ff">no </font>=> <font color="#ff00ff">'</font><font color="#ff00ff">tiger</font><font color="#ff00ff">'</font>, <font color="#ff00ff">yes </font>=> <font color="#ff00ff">'</font><font color="#ff00ff">shark</font><font color="#ff00ff">'</font> } );
<font color="#a52a2a">11 </font> }
<font color="#a52a2a">12 </font>);
<font color="#a52a2a">13 </font>
<font color="#a52a2a">14 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">play </font>{
<font color="#a52a2a">15 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">16 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$guess</font> = <font color="#008b8b">$self</font><font color="#008b8b">->tree</font>;
<font color="#a52a2a">17 </font> <font color="#a52a2a"><b>my</b></font> ( <font color="#008b8b">$node</font>, <font color="#008b8b">$branch</font> );
<font color="#a52a2a">18 </font> <font color="#a52a2a"><b>while</b></font> ( <font color="#a52a2a"><b>ref</b></font>(<font color="#008b8b">$guess</font>) ) {
<font color="#a52a2a">19 </font> <font color="#008b8b">$node</font> = <font color="#008b8b">$guess</font>;
<font color="#a52a2a">20 </font> <font color="#008b8b">$branch</font> = <font color="#008b8b">$self</font><font color="#008b8b">->yes</font>( <font color="#008b8b">$node</font><font color="#008b8b">->question</font> ) ? <font color="#ff00ff">"</font><font color="#ff00ff">yes</font><font color="#ff00ff">"</font> : <font color="#ff00ff">"</font><font color="#ff00ff">no</font><font color="#ff00ff">"</font>;
<font color="#a52a2a">21 </font> <font color="#008b8b">$guess</font> = <font color="#008b8b">$node</font>-><font color="#008b8b">$branch</font>;
<font color="#a52a2a">22 </font> }
<font color="#a52a2a">23 </font> <font color="#a52a2a"><b>return</b></font> <font color="#a52a2a"><b>if</b></font> <font color="#008b8b">$self</font><font color="#008b8b">->yes</font>(<font color="#ff00ff">"</font><font color="#ff00ff">Is it a(n) </font><font color="#008b8b">$guess</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">24 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$animal</font> = <font color="#008b8b">$self</font><font color="#008b8b">->prompt</font>(<font color="#ff00ff">"</font><font color="#ff00ff">Animal's name? : </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">25 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$diff</font> = <font color="#008b8b">$self</font><font color="#008b8b">->prompt</font>(
<font color="#a52a2a">26 </font> <font color="#ff00ff">"</font><font color="#ff00ff">A question true for </font><font color="#008b8b">$animal</font><font color="#ff00ff">, but false for </font><font color="#008b8b">$guess</font><font color="#ff00ff">: </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">27 </font> <font color="#008b8b">$node</font>-><font color="#008b8b">$branch</font>(
<font color="#a52a2a">28 </font> QuestionNode-><font color="#a52a2a"><b>new</b></font>( { <font color="#ff00ff">question </font>=> <font color="#008b8b">$diff</font>, <font color="#ff00ff">no </font>=> <font color="#008b8b">$guess</font>, <font color="#ff00ff">yes </font>=> <font color="#008b8b">$animal</font> } ) );
<font color="#a52a2a">29 </font>}
<font color="#a52a2a">30 </font>
<font color="#a52a2a">31 </font>__PACKAGE__->meta->make_immutable;
<font color="#a52a2a">32 </font><font color="#ff00ff">1</font>;
</pre><br />
ConsoleGame.pm:<br />
<pre><font color="#a52a2a"> 1 </font><font color="#a52a2a"><b>package</b></font><font color="#2e8b57"><b> ConsoleGame;</b></font>
<font color="#a52a2a"> 2 </font><font color="#a020f0">use </font>Moose;
<font color="#a52a2a"> 3 </font><font color="#a020f0">use </font>Term::ReadLine;
<font color="#a52a2a"> 4 </font><font color="#a020f0">use </font>IO::Handle;
<font color="#a52a2a"> 5 </font>
<font color="#a52a2a"> 6 </font>has <font color="#ff00ff">title </font>=> ( <font color="#ff00ff">is </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">ro</font><font color="#ff00ff">"</font>, <font color="#ff00ff">isa </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">Str</font><font color="#ff00ff">"</font>, <font color="#ff00ff">default </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">Animals' game</font><font color="#ff00ff">"</font> );
<font color="#a52a2a"> 7 </font>has <font color="#ff00ff">term </font>=> ( <font color="#ff00ff">is </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">ro</font><font color="#ff00ff">"</font>, <font color="#ff00ff">isa </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">Object</font><font color="#ff00ff">"</font>, <font color="#ff00ff">lazy_build </font>=> <font color="#ff00ff">1</font>,
<font color="#a52a2a"> 8 </font> <font color="#ff00ff">handles </font>=> { <font color="#ff00ff">prompt </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">readline</font><font color="#ff00ff">"</font> } );
<font color="#a52a2a"> 9 </font>
<font color="#a52a2a">10 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">_build_term </font>{
<font color="#a52a2a">11 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">12 </font> Term::ReadLine-><font color="#a52a2a"><b>new</b></font>( <font color="#008b8b">$self</font><font color="#008b8b">->title</font> );
<font color="#a52a2a">13 </font>}
<font color="#a52a2a">14 </font>
<font color="#a52a2a">15 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">yes </font>{
<font color="#a52a2a">16 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">17 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$prompt</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">18 </font> <font color="#a52a2a"><b>while</b></font> (<font color="#ff00ff">1</font>) {
<font color="#a52a2a">19 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$answer</font> = <font color="#008b8b">$self</font><font color="#008b8b">->prompt</font>(<font color="#ff00ff">"</font><font color="#008b8b">$prompt</font><font color="#ff00ff">? (y/n): </font><font color="#ff00ff">"</font>);
<font color="#a52a2a">20 </font> <font color="#a52a2a"><b>return</b></font> ( <font color="#008b8b">$2</font> ? <font color="#ff00ff">1</font> : <font color="#ff00ff">0</font> ) <font color="#a52a2a"><b>if</b></font> <font color="#008b8b">$answer</font> =~<font color="#a52a2a"><b> /</b></font><font color="#ff00ff">^</font><font color="#6a5acd">\s</font><font color="#6a5acd">*((</font><font color="#ff00ff">yes|y</font><font color="#6a5acd">)</font><font color="#ff00ff">|</font><font color="#6a5acd">(</font><font color="#ff00ff">no|n</font><font color="#6a5acd">))</font><font color="#6a5acd">\s</font><font color="#6a5acd">*</font><font color="#a52a2a"><b>/i</b></font>;
<font color="#a52a2a">21 </font> <font color="#008b8b">$self</font><font color="#008b8b">->term</font>->OUT-><font color="#a52a2a"><b>print</b></font>(<font color="#ff00ff">"</font><font color="#ff00ff">Please answer 'y' or 'n'</font><font color="#6a5acd">\n</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">22 </font> }
<font color="#a52a2a">23 </font>}
<font color="#a52a2a">24 </font>
<font color="#a52a2a">25 </font><font color="#a52a2a"><b>sub</b></font><font color="#008b8b"> </font><font color="#008b8b">run </font>{
<font color="#a52a2a">26 </font> <font color="#a52a2a"><b>my</b></font> <font color="#008b8b">$self</font> = <font color="#a52a2a"><b>shift</b></font>;
<font color="#a52a2a">27 </font> <font color="#008b8b">$self</font><font color="#008b8b">->play</font>;
<font color="#a52a2a">28 </font> <font color="#008b8b">$self</font><font color="#008b8b">->play</font> <font color="#a52a2a"><b>while</b></font> <font color="#008b8b">$self</font><font color="#008b8b">->yes</font>(<font color="#ff00ff">"</font><font color="#ff00ff">Do you want to play again</font><font color="#ff00ff">"</font>);
<font color="#a52a2a">29 </font>}
<font color="#a52a2a">30 </font>
<font color="#a52a2a">31 </font>__PACKAGE__->meta->make_immutable;
<font color="#a52a2a">32 </font><font color="#ff00ff">1</font>;
</pre><br />
QuestionNode.pm<br />
<pre><font color="#a52a2a">1 </font><font color="#a52a2a"><b>package</b></font><font color="#2e8b57"><b> QuestionNode;</b></font>
<font color="#a52a2a">2 </font><font color="#a020f0">use </font>Moose;
<font color="#a52a2a">3 </font>
<font color="#a52a2a">4 </font>has <font color="#ff00ff">question </font>=> ( <font color="#ff00ff">is </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">ro</font><font color="#ff00ff">"</font>, <font color="#ff00ff">isa </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">Str</font><font color="#ff00ff">"</font>, <font color="#ff00ff">required </font>=> <font color="#ff00ff">1</font> );
<font color="#a52a2a">5 </font>has [ <font color="#ff00ff">"</font><font color="#ff00ff">yes</font><font color="#ff00ff">"</font>, <font color="#ff00ff">"</font><font color="#ff00ff">no</font><font color="#ff00ff">"</font> ] => ( <font color="#ff00ff">is </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">rw</font><font color="#ff00ff">"</font>, <font color="#ff00ff">isa </font>=> <font color="#ff00ff">"</font><font color="#ff00ff">Str|QuestionNode</font><font color="#ff00ff">"</font>, <font color="#ff00ff">required </font>=> <font color="#ff00ff">1</font> );
<font color="#a52a2a">6 </font>
<font color="#a52a2a">7 </font>__PACKAGE__->meta->make_immutable;
<font color="#a52a2a">8 </font><font color="#ff00ff">1</font>;
</pre><br />
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.<br />
<br />
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.<br />
<br />
Game class is assembled by adding a class ConsoleGame (with its attributes) and a class AnimalsGame which in turn uses objects of type QuestionNode.<br />
<br />
game.pl just changes "extend" by "with" al line 5::<br />
<pre><span style="color: brown;"> </span>
<span style="color: brown;"> 5 </span>with <span style="color: magenta;">qw(</span><span style="color: magenta;">AnimalsGame ConsoleGame</span><span style="color: magenta;">)</span>;
</pre><br />
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.<br />
<br />
<pre><span style="color: brown;"> 2 </span><span style="color: #a020f0;">use </span>Moose::Role;
</pre><br />
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.<br />
<br />
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.<br />
<br />
Do not wait anymore. use Moose. now.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com8tag:blogger.com,1999:blog-699609172043710797.post-35449050107910347952010-01-04T04:49:00.000-04:302010-01-04T04:49:28.801-04:30Planet Perl Iron Man and Non-english entriesI have read the post of <a class="entry-source-link" href="http://d.hatena.ne.jp/tokuhirom/">Tokuhiro Matsuno</a> and I agree, but I don't like very much the idea of an english abstract.<br />
<br />
What I do (besides translating myself entries of interest for everyone) is to provide a link to a google translate at the beginning of the articles that I am not willing to translate, so anybody is just one click away of the translation.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-16572315491507023632009-12-07T08:38:00.001-04:302009-12-07T08:40:45.869-04:30Plack/PSGI performance[<a href="http://perliscopio.blogspot.com/2009/12/rendimiento-en-psgiplack.html">Original Spanish source</a>]<br />
In my post about PSGI & Plack I said that it was fast, to demonstrate this I benchmarked the program running as CGI in Apache (ACGI) as a standalone server in CGI::Emulate::PSGI (CEP) and as a native PSGI application.<br />
<br />
The test was very not rigorous, because I really just wanted to confirm what I've read.<br />
<br />
The command to report the rate was:<br />
<br />
<code>$ ab -n 1000 -c 10 -k "http://localhost:5000/cgi-bin/perldocweb?pod=PSGI&format=source"</code><br />
<br />
Which gave the following results:<br />
<br />
<table><tbody>
<tr style="text-align: center;"> <th></th> <th>ACGI<br />
</th> <th>CEP<br />
</th> <th>PSGI<br />
</th> </tr>
<tr> <td>Requests per second<br />
</td> <td style="text-align: right;">10.57<br />
</td> <td style="text-align: right;">267.17<br />
</td> <td style="text-align: right;">512.31<br />
</td> </tr>
<tr> <td>Time per request (ms)<br />
</td> <td style="text-align: right;">94.618<br />
</td> <td style="text-align: right;">3.743<br />
</td> <td style="text-align: right;">1.952<br />
</td> </tr>
<tr> <td>Transfer rate (kBps)<br />
</td> <td style="text-align: right;">179.52<br />
</td> <td style="text-align: right;">4539.79<br />
</td> <td style="text-align: right;">8686.67<br />
</td> </tr>
</tbody></table><br />
Just to see the raw speed, I made a small program to serve text files and compare the performance against Apache serving the same static files:<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!</span><span style="color: #a020f0;">/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>IO::File;
<span style="color: brown;"> 5 </span>
<span style="color: brown;"> 6 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$dir</span> = <span style="color: magenta;">"</span><span style="color: magenta;">/home/jrey/htdocs</span><span style="color: magenta;">"</span>;
<span style="color: brown;"> 7 </span>
<span style="color: brown;"> 8 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$app</span> =<span style="color: darkcyan;"> </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span>{
<span style="color: brown;"> 9 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$env</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">10 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$filename</span> = <span style="color: darkcyan;">$dir</span> . <span style="color: darkcyan;">$env->{</span><span style="color: magenta;">'</span><span style="color: magenta;">REQUEST_URI</span><span style="color: magenta;">'</span><span style="color: darkcyan;">}</span>;
<span style="color: brown;">11 </span> <span style="color: brown;"><b>return</b></span> [ <span style="color: magenta;">'</span><span style="color: magenta;">200</span><span style="color: magenta;">'</span>, [<span style="color: magenta;">'</span><span style="color: magenta;">Content-Type</span><span style="color: magenta;">'</span> => <span style="color: magenta;">"</span><span style="color: magenta;">text/plain</span><span style="color: magenta;">"</span>], IO::File-><span style="color: brown;"><b>new</b></span>(<span style="color: darkcyan;">$filename</span>) ];
<span style="color: brown;">12 </span>};
</pre><br />
The results for the command:<br />
<br />
<code>$ ab -n 1000 -c 10 -k "http://localhost:5000/PSGI.pod"</code><br />
<br />
where:<br />
<br />
<table><tbody>
<tr style="text-align: center;"> <th></th> <th>Plackup<br />
</th> <th>Apache<br />
</th> </tr>
<tr> <td>Requests per second<br />
</td> <td style="text-align: right;">614.69<br />
</td> <td style="text-align: right;">3217.03<br />
</td> </tr>
<tr> <td>Time per request (ms)<br />
</td> <td style="text-align: right;">1.627<br />
</td> <td style="text-align: right;">0.311<br />
</td> </tr>
<tr> <td>Transfer rate (kBps)<br />
</td> <td style="text-align: right;">10425.21<br />
</td> <td style="text-align: right;">55133.41<br />
</td> </tr>
</tbody></table><br />
As I said, Plack is very fast, and in particular this test shows that the performance is acceptable even for static content, so we can deploy applications directly on perl, without additional Web server components, except for special needs such as high availability and load balancing, in which case there are some perl based solutions solutions as well, for example <a href="http://www.danga.com/perlbal/">perlbal</a>. Did I told you that there is <a href="http://github.com/miyagawa/Perlbal-Plugin-PSGI">PSGI for perlbal</a>?Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-44432043464556461032009-12-06T19:36:00.002-04:302009-12-06T22:18:08.402-04:30CGI::Emulate::PSGI errorWhile working with the code of the <a href="http://perliscope.blogspot.com/2009/11/psgi-and-plack-future-of-web.html">previous article</a>, I realized that the example of <code>CGI::Emulate::PSGI</code> wasn't working, because I did not reset <code>CGI</code>'s global variables.<br />
Here is the correct way to do it:<br />
<br />
<pre><span style="color: brown;">1 </span><span style="color: #a020f0;">use </span>CGI::Emulate::PSGI;
<span style="color: brown;">2 </span><span style="color: #a020f0;">use </span>CGI;
<span style="color: brown;">3 </span>
<span style="color: brown;">4 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$app</span> = CGI::Emulate::PSGI->handler(<span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span>{
<span style="color: brown;">5 </span> CGI::initialize_globals();
<span style="color: brown;">6 </span> <span style="color: brown;"><b>do</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">perldocweb</span><span style="color: magenta;">"</span>;
<span style="color: brown;">7 </span>})
</pre>Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com2tag:blogger.com,1999:blog-699609172043710797.post-69875589271518666332009-11-30T01:48:00.002-04:302009-11-30T10:57:41.881-04:30PSGI and Plack: the future of web applications[<a href="http://perliscopio.blogspot.com/2009/11/psgi-y-plack-el-futuro-de-las.html">Original spanish source</a>]<br />
A few weeks ago I showed my friend Joel a one-liner in Perl it featured a web server, perhaps he had too much work to do because it did not seem surprised by this fantastic line of perl module using IO::All:<br />
<br />
<pre>perl -MIO::All -e 'io(<span style="color: magenta;">"</span><span style="color: magenta;">:8080</span><span style="color: magenta;">"</span>)-><span style="color: brown;"><b>fork</b></span>-><span style="color: brown;"><b>accept</b></span>->(<span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span>{ <span style="color: darkcyan;">$_[</span><span style="color: magenta;">0</span><span style="color: darkcyan;">]</span> < io(<span style="color: brown;"><b>-x</b></span> <span style="color: darkcyan;">$1</span> ? <span style="color: magenta;">"</span><span style="color: magenta;">./</span><span style="color: darkcyan;">$1</span><span style="color: magenta;"> |</span><span style="color: magenta;">"</span> : <span style="color: darkcyan;">$1</span>) <span style="color: brown;"><b>if</b></span><span style="color: brown;"><b> /</b></span><span style="color: magenta;">^GET </span><span style="color: slateblue;">\/</span><span style="color: slateblue;">(.*)</span><span style="color: magenta;"> </span><span style="color: brown;"><b>/</b></span> })'
</pre><br />
But surprisingly (especially for a Perl fan) his response was: "You know that Python's people have software to deploy powerfull web servers easily", I noticed that he did not understand my point, so I let him go.<br />
<br />
Although I was sure he was talking about <a href="http://wsgi.org/wsgi/">WSGI</a> (also known as <a href="http://www.python.org/dev/peps/pep-0333/">PEP-333</a>): a specification for a web application API, allowing the separation concerns between the interface (policy) and implementation (mechanisms).<br />
<br />
In Perl this was the job of <a href="http://search.cpan.org/perldoc?HTTP::Engine">HTTP::Engine</a> used among others by <a href="http://www.catalystframework.org/">Catalyst</a>.<br />
<br />
However, I was curious and I looked at CPAN, would there be something new out there?.<br />
<br />
I found modules like <a href="http://mojolicious.org/">Mojo</a>, which internally uses an interface similar to WSGI, however the most interesting thing I found was <a href="http://plackperl.org/">PSGI and Plack</a>.<br />
<br />
Apparently <a href="http://search.cpan.org/perldoc?HTTP::Engine">HTTP::Engine</a> is far from an ideal solution. I read it is monolithic, difficult to adapt and not very efficient, for embedded environments I guess, so <a href="http://profile.typepad.com/miyagawa">Miyagawa</a> decided to separate <a href="http://search.cpan.org/perldoc?HTTP::Engine">HTTP::Engine</a> into three parts:<br />
<ol><li>An specification: PSGI</li>
<li>A reference implementation: Plack::Server</li>
<li>Tools: Plack::* </li>
</ol>Most interesting about <a href="http://plackperl.org/">Plack and PSGI</a> is the pace at which it was implemented, only weeks ago it was an idea and for some time now there are reference implementations available, which allow applications to run standalone by Plack in a single thread or perfork, there are also interfaces for FastCGI, CGI and mod-perl of course, and as if this were not enough, PSGI has the ability to work with non-blocking I/O, so there are servers for <a href="http://search.cpan.org/perldoc?POE">POE</a>, <a href="http://search.cpan.org/perldoc?AnyEvent">AnyEvent</a> and <a href="http://search.cpan.org/perldoc?Coro">Coro</a>, there is even a PSGI module for Apache (<a href="http://github.com/spiritloose/mod_psgi/">mod-psgi</a>).<br />
<br />
On the other hand, PSGI adapters were developed for frameworks like <a href="http://www.catalystframework.org/">Catalyst</a> (<a href="http://search.cpan.org/perldoc?Catalyst::Engine::PSGI">Catalyst::Engine::PSGI</a>), <a href="http://search.cpan.org/perldoc?Squatting">Squatting</a> (<a href="http://search.cpan.org/perldoc?Squatting::On::PSGI">Squatting::On::PSGI</a>), <a href="http://search.cpan.org/perldoc?CGI::Application">CGI::Application</a> (<a href="http://search.cpan.org/perldoc?CGI::Application::PSGI">CGI::Application::PSGI</a>), <a href="http://dancer.sukria.net/">Dancer</a> and even for <a href="http://www.webgui.org/">WebGUI</a> (<a href="http://blog.patspam.com/2009/plebgui-webgui-meets-plack">PlebGUI</a>), there are tools to help in the migration from other technologies, for example if you have an application written for <a href="http://search.cpan.org/perldoc?HTTP::Engine">HTTP::Engine</a>, you can use it virtually unchanged in PSGI with <a href="http://search.cpan.org/perldoc?HTTP::Engine::Interface::PSGI">HTTP::Engine::Interface::PSGI</a>, if you have a CGI application you may migrate it with little modification with <a href="http://search.cpan.org/perldoc?CGI::PSGI">CGI::PSGI</a>, and if even this is too much work you can use <a href="http://search.cpan.org/perldoc?CGI::Emulate::PSGI">CGI::Emulate::PSGI</a> that supports running a CGI server from the command line!.<br />
<br />
In the <a href="http://perliscope.blogspot.com/2009/11/processing-pod-with-podsimple.html">last post</a> I made a toy POD document server, and I choose to implement it as a CGI, I gess that some people may had problems making it work, because it needed a running web server with the right CGI configuration in place.<br />
<br />
Using <a href="http://search.cpan.org/perldoc?CGI::Emulate::PSGI">CGI::Emulate::PSGI</a> you only write a program to start the server (perldocweb_starter):<br />
<br />
<pre><span style="color: brown;">1 </span><span style="color: #a020f0;">use </span>CGI::Emulate::PSGI;
<span style="color: brown;">2 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$app</span> = CGI::Emulate::PSGI->handler(<span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span>{ <span style="color: brown;"><b>do</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">perldocweb</span><span style="color: magenta;">"</span> })
</pre><br />
and then run the command plackup:<br />
<br />
<pre>$ plackup perldocweb_starter
Plack::Server::Standalone: Accepting connections at http://0:5000/
</pre><br />
now we have our documentation server running on port 5000, so browsing:<br />
<br />
<pre>http://localhost:5000/perldocweb?PSGI
</pre><br />
PSGI specification should appear in the browser, easy right?.<br />
<br />
If you are willing to modify your code, the emulator won't be necessary the application can be executed directly by <a href="http://search.cpan.org/perldoc?plackup">plackup</a>, and it will be much more efficient.<br />
<br />
The first modification is to change line 4 to use <a href="http://search.cpan.org/perldoc?CGI::PSGI">CGI::PSGI</a>, I also no longer use <a href="http://search.cpan.org/perldoc?CGI::Carp">CGI::Carp</a>, because Plack has a much more elegant way to display errors using <a href="http://search.cpan.org/perldoc?Devel::StackTrace::AsHTML">Devel::StackTrace::AsHTML</a>.<br />
<br />
When using CGI::PSGI the program must create (and return) a closure that will be our application so the main code between lines 20 and 50 (of the old code) should be inside a closure, also line 20 now must initialize a CGI::PSGI object, so I replaced it with the lines 20 to 22 of the new application:<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!</span><span style="color: #a020f0;">/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>CGI::PSGI;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>IO::File;
<span style="color: brown;"> 6 </span><span style="color: #a020f0;">use </span>Pod::Simple::Search;
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use </span>Pod::Simple::HTML;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%content_types</span> = (
<span style="color: brown;">10 </span> <span style="color: magenta;">RTF </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">application/rtf</span><span style="color: magenta;">"</span>,
<span style="color: brown;">11 </span> <span style="color: magenta;">LaTeX </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">application/x-latex</span><span style="color: magenta;">"</span>,
<span style="color: brown;">12 </span> <span style="color: magenta;">PDF </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">application/pdf</span><span style="color: magenta;">"</span>,
<span style="color: brown;">13 </span>);
<span style="color: brown;">14 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@wikis</span> = <span style="color: magenta;">qw(</span><span style="color: magenta;">Usemod Twiki Template Kwiki Confluence Moinmoin Tiddlywiki Mediawiki Textile</span><span style="color: magenta;">)</span>;
<span style="color: brown;">15 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%formats</span> = (
<span style="color: brown;">16 </span> ( <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">"</span><span style="color: magenta;">Pod::Simple::</span><span style="color: darkcyan;">$_</span><span style="color: magenta;">"</span> } <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%content_types</span> ),
<span style="color: brown;">17 </span> ( <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">"</span><span style="color: magenta;">Pod::Simple::Wiki::</span><span style="color: darkcyan;">$_</span><span style="color: magenta;">"</span> } <span style="color: darkcyan;">@wikis</span> )
<span style="color: brown;">18 </span>);
<span style="color: brown;">19 </span>
<span style="color: brown;">20 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$app</span> =<span style="color: darkcyan;"> </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span>{
<span style="color: brown;">21 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$env</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">22 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$q</span> = CGI::PSGI-><span style="color: brown;"><b>new</b></span>(<span style="color: darkcyan;">$env</span>);
<span style="color: brown;">23 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$filename</span> = Pod::Simple::Search-><span style="color: brown;"><b>new</b></span>->inc(<span style="color: magenta;">1</span>)->find( <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">pod</span><span style="color: magenta;">"</span>) );
<span style="color: brown;">24 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$format</span> = <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">format</span><span style="color: magenta;">"</span>) || <span style="color: magenta;">"</span><span style="color: magenta;">HTML</span><span style="color: magenta;">"</span>;
<span style="color: brown;">25 </span> given (<span style="color: darkcyan;">$format</span>) {
<span style="color: brown;">26 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">source</span><span style="color: magenta;">"</span>) {
<span style="color: brown;">27 </span> <span style="color: brown;"><b>return</b></span> [ <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->psgi_header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/plain</span><span style="color: magenta;">"</span>), IO::File-><span style="color: brown;"><b>new</b></span>(<span style="color: darkcyan;">$filename</span>) ];
<span style="color: brown;">28 </span> }
<span style="color: brown;">29 </span> when (<span style="color: magenta;">'</span><span style="color: magenta;">HTML</span><span style="color: magenta;">'</span>) {
<span style="color: brown;">30 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$parser</span> = Pod::Simple::HTML-><span style="color: brown;"><b>new</b></span>;
<span style="color: brown;">31 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->perldoc_url_prefix</span>( <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->url</span>( -<span style="color: magenta;">path_info </span>=> <span style="color: magenta;">1</span> ) . <span style="color: magenta;">"</span><span style="color: magenta;">?pod=</span><span style="color: magenta;">"</span> );
<span style="color: brown;">32 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$footer</span> = <span style="color: magenta;">"</span><span style="color: magenta;"><hr></span><span style="color: magenta;">"</span>
<span style="color: brown;">33 </span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;"> </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>map</b></span> { make_link( <span style="color: darkcyan;">$_</span>, <span style="color: darkcyan;">$q</span> ) } <span style="color: magenta;">"</span><span style="color: magenta;">source</span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%content_types</span> )
<span style="color: brown;">34 </span> . <span style="color: magenta;">"</span><span style="color: magenta;"> | Wiki formats: </span><span style="color: magenta;">"</span>
<span style="color: brown;">35 </span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;"> </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>map</b></span> { make_link( <span style="color: darkcyan;">$_</span>, <span style="color: darkcyan;">$q</span> ) } <span style="color: darkcyan;">@wikis</span> );
<span style="color: brown;">36 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->html_footer</span>(qq[\n<!-- end doc -->\n\n<span style="color: darkcyan;">$footer</span></body></html>\n]);
<span style="color: brown;">37 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->output_string</span>( <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$output</span> );
<span style="color: brown;">38 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->parse_file</span>(<span style="color: darkcyan;">$filename</span>);
<span style="color: brown;">39 </span> <span style="color: brown;"><b>return</b></span> [ <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->psgi_header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/html</span><span style="color: magenta;">"</span>), [<span style="color: darkcyan;">$output</span>] ];
<span style="color: brown;">40 </span> }
<span style="color: brown;">41 </span> when (<span style="color: darkcyan;">%formats</span>) {
<span style="color: brown;">42 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$class</span> = <span style="color: darkcyan;">$formats{$format}</span>;
<span style="color: brown;">43 </span> <span style="color: brown;"><b>eval</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">require </span><span style="color: darkcyan;">$class</span><span style="color: magenta;">"</span>;
<span style="color: brown;">44 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$parser</span> = <span style="color: darkcyan;">$class</span><span style="color: darkcyan;">->new</span>;
<span style="color: brown;">45 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->output_string</span>( <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$output</span> );
<span style="color: brown;">46 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->parse_file</span>(<span style="color: darkcyan;">$filename</span>);
<span style="color: brown;">47 </span> <span style="color: brown;"><b>return</b></span> [ <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->psgi_header</span>( <span style="color: darkcyan;">$content_types{$format}</span> || <span style="color: magenta;">"</span><span style="color: magenta;">text/plain</span><span style="color: magenta;">"</span> ), [<span style="color: darkcyan;">$output</span>] ];
<span style="color: brown;">48 </span> }
<span style="color: brown;">49 </span> default {
<span style="color: brown;">50 </span> <span style="color: brown;"><b>die</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">Formato desconocido '</span><span style="color: darkcyan;">$format</span><span style="color: magenta;">'</span><span style="color: magenta;">"</span>);
<span style="color: brown;">51 </span> }
<span style="color: brown;">52 </span> }
<span style="color: brown;">53 </span>};
<span style="color: brown;">54 </span>
<span style="color: brown;">55 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">make_link </span>{
<span style="color: brown;">56 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$fmt</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">57 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$q</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">58 </span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->a</span>( { <span style="color: magenta;">href </span>=> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->url</span>( -<span style="color: magenta;">path_info </span>=> <span style="color: magenta;">1</span>, -<span style="color: magenta;">query </span>=> <span style="color: magenta;">1</span> ) . <span style="color: magenta;">"</span><span style="color: slateblue;">\&</span><span style="color: magenta;">format=</span><span style="color: darkcyan;">$fmt</span><span style="color: magenta;">"</span> }, <span style="color: darkcyan;">$fmt</span> );
<span style="color: brown;">59 </span>}
</pre><br />
The closure receives a PSGI environment as a parameter (line 21) and uses it to create the object $q that we may use like a regular CGI object.<br />
This closure should return an array of two elements:<br />
<ol><li>The headers: an array of alternating header names and values<br />
</li>
<li>The body: an array of lines or an <a href="http://search.cpan.org/perldoc?IO::Handle">IO::Handle</a> object</li>
</ol>A major difference between <a href="http://search.cpan.org/perldoc?CGI::PSGI">CGI::PSGI</a> and <a href="http://search.cpan.org/perldoc?CGI">CGI</a> is that in the later anything written to STDOUT is sent to browser, whereas in the former the body is returned.<br />
<br />
So the generation of content in the application must be changed, the source code case (line 26) is more simple than the CGI version because I just need to return the headers together with an <a href="http://search.cpan.org/perldoc?IO::Handle">IO::Handle</a> object (created with <a href="http://search.cpan.org/perldoc?IO::File">IO::File</a>). CGI::PSGI is responsible for reading the object's data and send it to the browser, if the handle is a real file (as in this case) and the operating system has sendfile(2) (as in linux), sending data is done entirely by the kernel so there is not difference in efficiency between this program and one optimized in C (like Apache).<br />
<br />
In the case of HTML (line 29) I have changed the use of <code>output_fh</code> by <code>output_string</code> to store the content generated by <a href="http://search.cpan.org/perldoc?Pod::Simple">Pod::Simple</a> into $output, which is later returned in line 39.<br />
<br />
As I can not longer use the <code>STDOUT</code> to send the content to the browser I can not use the shortcut <code>$class->filter</code> of <a href="http://search.cpan.org/perldoc?Pod::Simple">Pod::Simple</a>, so I've replaced it by its equivalent in lines 44 to 46 of the new application.<br />
<br />
Although perhaps not obvious, the code returns the closure (line 20) because it is the last computed value in the file.<br />
<br />
If we call our new program "server_pod", you can start it with plackup as follows:<br />
<br />
<pre>$ plackup server_pod
Plack::Server::Standalone: Accepting connections at http://0:5000/
</pre><br />
after that, POD content could be browsed as showed before, plackup is using it's default server (<a href="http://search.cpan.org/perldoc?Plack::Server::Standalone">Plack::Server::Standalone</a>) a single threaded process which is ideal for development or for personal use, but if you need a production-quality server you should see other options, for migrated CGI code I recommend <a href="http://search.cpan.org/perldoc?Plack::Server::Standalone::Prefork">Plack::Server::Standalone::Prefork</a>, which may be started like this:<br />
<br />
<pre>$ plackup -s Standalone::Prefork server_pod
Plack::Server::Standalone: Accepting connections at http://0:5000/
</pre><br />
That was easy, default values are used for everything, but if you need to tune the server, you can give options to <a href="http://search.cpan.org/perldoc?plackup">plackup</a>, each server has specific options documented in their implementation class.<br />
<br />
Finally, this code is much more efficient than the emulator in the first example because it does not need to use temporary files for capturing the standard output, but you can still run it in CGI, FastCGI or even mod-perl mode under Apache.<br />
<br />
The next time I will improve the application to use Plack and its <a href="http://search.cpan.org/perldoc?Plack::Middleware">middleware</a>.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-18192144773811355292009-11-30T00:02:00.006-04:302009-11-30T02:02:52.705-04:30PSGI y Plack: el futuro de las aplicaciones webEste artículo no debió publicarse aquí, lo moví a <a href="http://perliscopio.blogspot.com/2009/11/psgi-y-plack-el-futuro-de-las.html">donde pertenece</a> en <a href="http://perliscopio.blogspot.com/">Perliscopio</a>, disculpen la molestia.<br />
<br />
This should not be published here, I moved the article <a href="http://perliscopio.blogspot.com/2009/11/psgi-y-plack-el-futuro-de-las.html">where it belongs</a> at <a href="http://perliscopio.blogspot.com/">Perliscopio</a>, sorry for the inconvenience.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-66789626384652890152009-11-21T08:21:00.000-04:302009-11-21T08:21:24.648-04:30Processing POD with Pod::Simple[<a href="http://perliscopio.blogspot.com/2009/11/procesando-pod-con-podsimple.html">Original spanish content</a>]<br />
In the <a href="http://perliscope.blogspot.com/2009/11/perl-documetantion-tools.html">last article</a> we translated POD to HTML easily for a minimal documentation server using CGI, today I wil expand the application enabling visualization of POD documents in a dozen different ways.<br />
<br />
An useful option when I read the documentation at CPAN, is the ability to display the source code of the modules, so I'll add a link to view the source of a document, I'll put the link at the bottom of the document, setting the footer of the HTML conversion, I must also add logic to recognize the new type of link.<br />
<br />
I will add a format parameter to the query, which will be interpreted with at line 12, to be compatible with the previous version, I will make this parameter optional defaulting to HTML (line 11):<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!</span><span style="color: #a020f0;">/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>CGI;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>CGI::Carp <span style="color: magenta;">'</span><span style="color: magenta;">fatalsToBrowser</span><span style="color: magenta;">'</span>;
<span style="color: brown;"> 6 </span><span style="color: #a020f0;">use </span>Pod::Simple::Search;
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use </span>Pod::Simple::HTML;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$q</span> = <span style="color: brown;"><b>new</b></span> CGI;
<span style="color: brown;">10 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$filename</span> = Pod::Simple::Search-><span style="color: brown;"><b>new</b></span>->inc(<span style="color: magenta;">1</span>)->find( <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">pod</span><span style="color: magenta;">"</span>) );
<span style="color: brown;">11 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$format</span> = <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">format</span><span style="color: magenta;">"</span>) || <span style="color: magenta;">"</span><span style="color: magenta;">HTML</span><span style="color: magenta;">"</span>;
<span style="color: brown;">12 </span>given (<span style="color: darkcyan;">$format</span>) {
<span style="color: brown;">13 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">source</span><span style="color: magenta;">"</span>) {
<span style="color: brown;">14 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/plain</span><span style="color: magenta;">"</span>);
<span style="color: brown;">15 </span> <span style="color: brown;"><b>open</b></span> <span style="color: darkcyan;">POD</span>, <span style="color: darkcyan;">$filename</span>;
<span style="color: brown;">16 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$_</span> <span style="color: brown;"><b>while</b></span> (<span style="color: darkcyan;"><POD></span>);
<span style="color: brown;">17 </span> }
<span style="color: brown;">18 </span> when (<span style="color: magenta;">'</span><span style="color: magenta;">HTML</span><span style="color: magenta;">'</span>) {
<span style="color: brown;">19 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$parser</span> = Pod::Simple::HTML-><span style="color: brown;"><b>new</b></span>;
<span style="color: brown;">20 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/html</span><span style="color: magenta;">"</span>);
<span style="color: brown;">21 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->perldoc_url_prefix</span>( <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->url</span>( -<span style="color: magenta;">path_info </span>=> <span style="color: magenta;">1</span> ) . <span style="color: magenta;">"</span><span style="color: magenta;">?pod=</span><span style="color: magenta;">"</span> );
<span style="color: brown;">22 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$footer</span> = <span style="color: magenta;">"</span><span style="color: magenta;"><hr></span><span style="color: magenta;">"</span> . make_link(<span style="color: magenta;">"</span><span style="color: magenta;">source</span><span style="color: magenta;">"</span>);
<span style="color: brown;">23 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->html_footer</span>(qq[\n<!-- end doc -->\n\n<span style="color: darkcyan;">$footer</span></body></html>\n]);
<span style="color: brown;">24 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->output_fh</span>(*STDOUT);
<span style="color: brown;">25 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->parse_file</span>(<span style="color: darkcyan;">$filename</span>);
<span style="color: brown;">26 </span> }
<span style="color: brown;">27 </span> default {
<span style="color: brown;">28 </span> <span style="color: brown;"><b>die</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">Formato desconocido '</span><span style="color: darkcyan;">$format</span><span style="color: magenta;">'</span><span style="color: magenta;">"</span>);
<span style="color: brown;">29 </span> }
<span style="color: brown;">30 </span>}
<span style="color: brown;">31 </span>
<span style="color: brown;">32 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">make_link </span>{
<span style="color: brown;">33 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$fmt</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">34 </span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->a</span>( { <span style="color: magenta;">href </span>=> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->url</span>( -<span style="color: magenta;">path_info </span>=> <span style="color: magenta;">1</span>, -<span style="color: magenta;">query </span>=> <span style="color: magenta;">1</span> ) . <span style="color: magenta;">"</span><span style="color: slateblue;">\&</span><span style="color: magenta;">format=</span><span style="color: darkcyan;">$fmt</span><span style="color: magenta;">"</span> }, <span style="color: darkcyan;">$fmt</span> );
<span style="color: brown;">35 </span>}
</pre><br />
This is much bigger than our previous application, however this architecture will prove its flexibility very soon when combined with <a href="http://search.cpan.org/perldoc?Pod::Simple">Pod::Simple</a> and friends. Showing source code is a snap, just send the header (line 14) and then the rest of the file without further processing.<br />
<br />
The make_link subroutine helps in the creation of links with the format parameter, using the URL being visited (including the query), and though it is used only once (line 22), we'll use more as wwe add conversion formats to the application.<br />
<br />
Another used module was CGI::Carp with the "fatalsToBrowser" option which sends fatal errors to the browser, if you want to try this, just put an unknown format and see the error message in the browser.<br />
<br />
Having said that let's translate POD to Wiki, I will use "Pod::Simple::Wiki" which has converters for at least 9 different wiki formats, so no matter if you use Mediawiki or Twiki, you can always write your articles in POD :-)<br />
<br />
Since Perl is dynamic, flexible a easy, I'm going to add all formats at once, for which I need an array with all the supported formats (line 9) and a map of formats associated with their POD translators (line 10):<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!</span><span style="color: #a020f0;">/usr/bin/perl</span>
<span style="color: brown;"> 2</span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>CGI;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>CGI::Carp <span style="color: magenta;">'</span><span style="color: magenta;">fatalsToBrowser</span><span style="color: magenta;">'</span>;
<span style="color: brown;"> 6 </span><span style="color: #a020f0;">use </span>Pod::Simple::Search;
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use </span>Pod::Simple::HTML;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@wikis</span> = <span style="color: magenta;">qw(</span><span style="color: magenta;">Usemod Twiki Template Kwiki Confluence Moinmoin Tiddlywiki Mediawiki Textile</span><span style="color: magenta;">)</span>;
<span style="color: brown;">10 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%formats</span> = (
<span style="color: brown;">11 </span> ( <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">"</span><span style="color: magenta;">Pod::Simple::Wiki::</span><span style="color: darkcyan;">$_</span><span style="color: magenta;">"</span> } <span style="color: darkcyan;">@wikis</span> )
<span style="color: brown;">12 </span>);
<span style="color: brown;">13 </span>
<span style="color: brown;">14 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$q</span> = <span style="color: brown;"><b>new</b></span> CGI;
<span style="color: brown;">15 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$filename</span> = Pod::Simple::Search-><span style="color: brown;"><b>new</b></span>->inc(<span style="color: magenta;">1</span>)->find( <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">pod</span><span style="color: magenta;">"</span>) );
<span style="color: brown;">16 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$format</span> = <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">format</span><span style="color: magenta;">"</span>) || <span style="color: magenta;">"</span><span style="color: magenta;">HTML</span><span style="color: magenta;">"</span>;
<span style="color: brown;">17 </span>given (<span style="color: darkcyan;">$format</span>) {
<span style="color: brown;">18 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">source</span><span style="color: magenta;">"</span>) {
<span style="color: brown;">19 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/plain</span><span style="color: magenta;">"</span>);
<span style="color: brown;">20 </span> <span style="color: brown;"><b>open</b></span> <span style="color: darkcyan;">POD</span>, <span style="color: darkcyan;">$filename</span>;
<span style="color: brown;">21 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$_</span> <span style="color: brown;"><b>while</b></span> (<span style="color: darkcyan;"><POD></span>);
<span style="color: brown;">22 </span> }
<span style="color: brown;">23 </span> when (<span style="color: magenta;">'</span><span style="color: magenta;">HTML</span><span style="color: magenta;">'</span>) {
<span style="color: brown;">24 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$parser</span> = Pod::Simple::HTML-><span style="color: brown;"><b>new</b></span>;
<span style="color: brown;">25 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/html</span><span style="color: magenta;">"</span>);
<span style="color: brown;">26 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->perldoc_url_prefix</span>( <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->url</span>( -<span style="color: magenta;">path_info </span>=> <span style="color: magenta;">1</span> ) . <span style="color: magenta;">"</span><span style="color: magenta;">?pod=</span><span style="color: magenta;">"</span> );
<span style="color: brown;">27 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$footer</span> = <span style="color: magenta;">"</span><span style="color: magenta;"><hr></span><span style="color: magenta;">"</span> . make_link(<span style="color: magenta;">"</span><span style="color: magenta;">source</span><span style="color: magenta;">"</span>)
<span style="color: brown;">28 </span> . <span style="color: magenta;">"</span><span style="color: magenta;"> | Wiki formats: </span><span style="color: magenta;">"</span>
<span style="color: brown;">29 </span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;"> </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>map</b></span> { make_link(<span style="color: darkcyan;">$_</span>) } <span style="color: darkcyan;">@wikis</span> );
<span style="color: brown;">30 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->html_footer</span>(qq[\n<!-- end doc -->\n\n<span style="color: darkcyan;">$footer</span></body></html>\n]);
<span style="color: brown;">31 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->output_fh</span>(*STDOUT);
<span style="color: brown;">32 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->parse_file</span>(<span style="color: darkcyan;">$filename</span>);
<span style="color: brown;">33 </span> }
<span style="color: brown;">34 </span> when (<span style="color: darkcyan;">%formats</span>) {
<span style="color: brown;">35 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$class</span> = <span style="color: darkcyan;">$formats{$format}</span>;
<span style="color: brown;">36 </span> <span style="color: brown;"><b>eval</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">require </span><span style="color: darkcyan;">$class</span><span style="color: magenta;">"</span>;
<span style="color: brown;">37 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>( <span style="color: magenta;">"</span><span style="color: magenta;">text/plain</span><span style="color: magenta;">"</span> );
<span style="color: brown;">38 </span> <span style="color: darkcyan;">$class</span><span style="color: darkcyan;">->filter</span>(<span style="color: darkcyan;">$filename</span>);
<span style="color: brown;">39 </span> }
<span style="color: brown;">40 </span> default {
<span style="color: brown;">41 </span> <span style="color: brown;"><b>die</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">Formato desconocido '</span><span style="color: darkcyan;">$format</span><span style="color: magenta;">'</span><span style="color: magenta;">"</span>);
<span style="color: brown;">42 </span> }
<span style="color: brown;">43 </span>}
<span style="color: brown;">44 </span>
<span style="color: brown;">45 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">make_link </span>{
<span style="color: brown;">46 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$fmt</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">47 </span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->a</span>( { <span style="color: magenta;">href </span>=> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->url</span>( -<span style="color: magenta;">path_info </span>=> <span style="color: magenta;">1</span>, -<span style="color: magenta;">query </span>=> <span style="color: magenta;">1</span> ) . <span style="color: magenta;">"</span><span style="color: slateblue;">\&</span><span style="color: magenta;">format=</span><span style="color: darkcyan;">$fmt</span><span style="color: magenta;">"</span> }, <span style="color: darkcyan;">$fmt</span> );
<span style="color: brown;">48 </span>}
</pre><br />
Most work is done to when some of the new formats is recognized at line 34, where we get the class of "Pod::Simple::Wiki" that implements the translation, then dynamically require this class through eval (line 36), thus we don' t have to load all the wiki translators at the beginning of the program, using just the needed bits for the desired translation, then we sent the content type and the translated (filtered) POD to the browser.<br />
<br />
Finally I includes links to the different formats in the footer, which is done during the generation of HTML page (lines 27 to 29).<br />
<br />
If want to include some of the documentation in a printed manual you probably want to convert POD for tools most suited to this work. Lets translate POD to RTF and LaTeX which should not be very difficult because there are already classes in the CPAN to do this, the first is to generalize the type of content sent to the browser, allowing to use it for different formats:<br />
<br />
<pre><span style="color: brown;">37 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>( <span style="color: darkcyan;">$content_types{$format}</span> || <span style="color: magenta;">"</span><span style="color: magenta;">text/plain</span><span style="color: magenta;">"</span> );</pre><br />
This assumes that there is a hash that will associate the formats with their content type, we'll also use this map to create links to new types of content:<br />
<br />
<pre><span style="color: brown;">27 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$footer</span> = <span style="color: magenta;">"</span><span style="color: magenta;"><hr></span><span style="color: magenta;">"</span> . make_link(<span style="color: magenta;">"</span><span style="color: magenta;">source</span><span style="color: magenta;">"</span>)
<span style="color: brown;">28 </span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;"> | </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>map</b></span> { make_link(<span style="color: darkcyan;">$_</span>) } <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%content_types</span> )
<span style="color: brown;">29 </span> . <span style="color: magenta;">"</span><span style="color: magenta;"> Wiki formats: </span><span style="color: magenta;">"</span>
<span style="color: brown;">30 </span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;"> | </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>map</b></span> { make_link(<span style="color: darkcyan;">$_</span>) } <span style="color: darkcyan;">@wikis</span> );
</pre><br />
The content type map may be added at the beginning:<br />
<br />
<pre><span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%content_types</span> = (
<span style="color: brown;">10 </span> <span style="color: magenta;">RTF </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">application/rtf</span><span style="color: magenta;">"</span>,
<span style="color: brown;">11 </span> <span style="color: magenta;">LaTeX </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">application/x-latex</span><span style="color: magenta;">"</span>,
<span style="color: brown;">12 </span>);
</pre><br />
and don't forget that every format must be listed in the %formats hash to be recognized and processed:<br />
<br />
<pre><span style="color: brown;">1</span><span style="color: brown;">4 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%formats</span> = (
<span style="color: brown;">15 </span> ( <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">"</span><span style="color: magenta;">Pod::Simple::</span><span style="color: darkcyan;">$_</span><span style="color: magenta;">"</span> } <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%content_types</span> ),
<span style="color: brown;">16 </span> ( <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">"</span><span style="color: magenta;">Pod::Simple::Wiki::</span><span style="color: darkcyan;">$_</span><span style="color: magenta;">"</span> } <span style="color: darkcyan;">@wikis</span> )
<span style="color: brown;">17 </span>);
</pre><br />
Now you can convert to RTF, which will surely start your favorite office suite, and in the case of LaTeX probably will download the file.<br />
<br />
<span class="long_text" id="result_box"><span style="background-color: white;" title="Para cerrar, voy a incluir un último formato: PDF, este será más complejo porque no hay un módulo en el CPAN que transforme POD a PDF, por ello voy a hacerme uno, basado en Pod::Simple (línea 5), que use">I will include a final format: PDF, this will be more complex because there is no CPAN module to translate POD to PDF, so I'm going to make me one, based on Pod:: Simple (line 5), which use </span><span style="background-color: white;" title="LaTeX como formato intermedio para crear los PDF.">LaTeX as an intermediate format to create the PDF.</span></span><br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: brown;"><b>package</b></span><span style="color: seagreen;"><b> Pod::Simple::PDF;</b></span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Pod::Simple::LaTeX;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use base</span> <span style="color: magenta;">"</span><span style="color: magenta;">Pod::Simple</span><span style="color: magenta;">"</span>;
<span style="color: brown;"> 6 </span>
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use </span>File::Temp;
<span style="color: brown;"> 8 </span><span style="color: #a020f0;">use </span>File::Spec::Functions;
<span style="color: brown;"> 9 </span><span style="color: #a020f0;">use </span>IO::File;
<span style="color: brown;">10 </span><span style="color: #a020f0;">use </span>IO::Handle;
<span style="color: brown;">11 </span>
<span style="color: brown;">12 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">new </span>{
<span style="color: brown;">13 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$class</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">14 </span> <span style="color: brown;"><b>return</b></span> <span style="color: brown;"><b>bless</b></span> { <span style="color: magenta;">output_fh </span>=> \*STDOUT }, <span style="color: brown;"><b>ref</b></span> <span style="color: darkcyan;">$class</span> || <span style="color: darkcyan;">$class</span>;
<span style="color: brown;">15 </span>}
<span style="color: brown;">16 </span>
<span style="color: brown;">17 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">parse_file </span>{
<span style="color: brown;">18 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$self</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">19 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$file</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">20 </span>
<span style="color: brown;">21 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$dir</span> = File::Temp->newdir();
<span style="color: brown;">22 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$tex_name</span> = catfile( <span style="color: darkcyan;">$dir</span>, <span style="color: magenta;">"</span><span style="color: magenta;">pod.tex</span><span style="color: magenta;">"</span> );
<span style="color: brown;">23 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$texf</span> = IO::File-><span style="color: brown;"><b>new</b></span>( <span style="color: darkcyan;">$tex_name</span>, <span style="color: magenta;">"</span><span style="color: magenta;">w</span><span style="color: magenta;">"</span> );
<span style="color: brown;">24 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$parser</span> = Pod::Simple::LaTeX-><span style="color: brown;"><b>new</b></span>;
<span style="color: brown;">25 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->output_fh</span>(<span style="color: darkcyan;">$texf</span>);
<span style="color: brown;">26 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->parse_file</span>(<span style="color: darkcyan;">$file</span>);
<span style="color: brown;">27 </span> <span style="color: darkcyan;">$texf</span><span style="color: darkcyan;">->close</span>;
<span style="color: brown;">28 </span> <span style="color: brown;"><b>`</b></span><span style="color: magenta;">cd '</span><span style="color: darkcyan;">$dir</span><span style="color: magenta;">'; pdflatex '</span><span style="color: darkcyan;">$tex_name</span><span style="color: magenta;">'; pdflatex '</span><span style="color: darkcyan;">$tex_name</span><span style="color: magenta;">'</span><span style="color: brown;"><b>`</b></span>;
<span style="color: brown;">29 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$in</span> = IO::File-><span style="color: brown;"><b>new</b></span>( catfile( <span style="color: darkcyan;">$dir</span>, <span style="color: magenta;">"</span><span style="color: magenta;">pod.pdf</span><span style="color: magenta;">"</span> ), <span style="color: magenta;">"</span><span style="color: magenta;">r</span><span style="color: magenta;">"</span> );
<span style="color: brown;">30 </span> <span style="color: darkcyan;">$self->{</span><span style="color: magenta;">'</span><span style="color: magenta;">output_fh</span><span style="color: magenta;">'</span><span style="color: darkcyan;">}</span>-><span style="color: brown;"><b>print</b></span>(<span style="color: darkcyan;">$_</span>) <span style="color: brown;"><b>while</b></span> <span style="color: brown;"><b>readline</b></span>(<span style="color: darkcyan;">$in</span>);
<span style="color: brown;">31 </span>}
<span style="color: brown;">32 </span>
<span style="color: brown;">33 </span><span style="color: magenta;">1</span>;
</pre><br />
<span class="long_text" id="result_box"><span style="background-color: white;" title="Tal vez la razón por la cual no hay conversor a PDF es porque no hay una manera muy portable de hacerlo, yo voy usar la herramienta pdflatex que es parte de TeX Live, porque supongo que se puede instalar tanto en Unix como en Windows, sin">Perhaps the reason of why there is not a PDF converter module is because there is not a very portable way to do it, I'll use the pdflatex tool that is part of TeX Live, because I suppose that it can be installed both on Unix and Windows, although</span><span style="background-color: white;" title="embargo cualquier distribución moderna de TeX en unix debería incluir esta herramienta."> any modern unix TeX distribution should include this tool</span></span>.<br />
<br />
<span class="long_text" id="result_box"><span style="background-color: white;" title="El método parse_file crea un directorio temporal usando File::Temp->newdir">The parse_file method creates a temporary directory using</span></span> <code>File::Temp->newdir</code><span class="long_text" id="result_box"><span style="background-color: white;" title="para luego crear el archivo pod.tex dentro del directorio, que se usa para almacenar el resultado de la conversión realizada con Pod::Simple::LaTeX, este archivo ahora se procesa con el comando 'pdflatex' (línea 27) que produce el"> then creates the file pod.tex (within the temporary directory), which is used to store the result of conversion performed with Pod:: Simple:: LaTeX, this file is now processed with the command 'pdflatex' (line 27) that produces the </span><span style="background-color: white;" title="archivo 'pod.pdf' (y uno que otro archivo inútil) en el directorio temporal.">file 'pod.pdf' (and some other useless files) into the temporary directory.</span></span><br />
<br />
<span class="long_text" id="result_box"><span style="background-color: white;" title="Muchas cosas pueden salir mal durante el proceso de la línea 27 y con el método simple que estoy usando tenemos muy poco control sobre lo que allí sucede, en una implementación mejorada habría que usar módulos como IPC::Run3 para controlar la ejecución de las herramientas">Many things can go wrong at line 27 because the simple method I'm using to execute the tool have very little control over what happens there, in an improved implementation we should use modules like <a href="http://search.cpan.org/perldoc?IPC::Run3">IPC::Run3</a> to control the execution of the tools </span><span style="background-color: white;" title="y actuar correctamente ante las diversas fallas que pudieran ocurrir, sin embargo una de las caracteristicas interesantes de Perl es que se pueden hacer prototipos como este rápidamente y después se pueden refinar.">and act appropriately on any failures that might occur, yet one of the interesting features of Perl is that you can make prototypes like this quickly and trefine them later.</span></span><br />
<br />
<span class="long_text" id="result_box"><span style="background-color: white;" title="Finalmente se transmite 'pod.pdf' al navegador (líneas 28 y 29), y al terminar el método parse file, la variable $dir sale de contexto y el objeto File::Temp se destruye, eliminando el directorio temporal junto con todo lo">In lines 28 & 29 'pod.pdf' is sent to the browser, and when the parse method returns, $dir variable goes out of scope and the object File::Temp is destroyed, deleting the temporary directory along with everything </span><span style="background-color: white;" title="que este dentro.">inside it</span></span>.<br />
<br />
<span class="long_text" id="result_box"><span style="background-color: white;" title="Una vez que este módulo se guarda en el lugar apropiado, lo que hace automáticamente el CPAN si el módulo esta empaquetado según las instrucciones de perlmodlib (aunque ahora solo para probar puedes poner el archivo PDF.pm en el mismo directorio donde se encuentra el archivo">Once this module is stored in the right place, where CPAN places it when the module is packaged as instructed in <a href="http://perldoc.perl.org/perlmodlib.html">perlmodlib</a> (though now just for testing you may put PDF.pm in the same directory of </span><span style="background-color: white;" title="HTML.pm que contiene Pod::Simple::HTML).">Pod::Simple::HTML).</span></span><br />
<br />
<span class="long_text" id="result_box"><span style="background-color: white;" title="Finalmente hay que agregar el nuevo tipo de contenido (PDF) a la aplicación lo cual es tan simple como agregar una sola línea al hash %content_types (línea 12) sin necesidad de tocar mas nada, lo que deja nuestro servidor de documentación así:">Finally a new content type (PDF) must be added, now this is very easy just add it to the hash %content_types (line 12) and that's it, we have a server capable of showing POD in over a dozen formats:</span></span><br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!</span><span style="color: #a020f0;">/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>CGI;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>CGI::Carp <span style="color: magenta;">'</span><span style="color: magenta;">fatalsToBrowser</span><span style="color: magenta;">'</span>;
<span style="color: brown;"> 6 </span><span style="color: #a020f0;">use </span>Pod::Simple::Search;
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use </span>Pod::Simple::HTML;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%content_types</span> = (
<span style="color: brown;">10 </span> <span style="color: magenta;">RTF </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">application/rtf</span><span style="color: magenta;">"</span>,
<span style="color: brown;">11 </span> <span style="color: magenta;">LaTeX </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">application/x-latex</span><span style="color: magenta;">"</span>,
<span style="color: brown;">12 </span> <span style="color: magenta;">PDF </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">application/pdf</span><span style="color: magenta;">"</span>,
<span style="color: brown;">13 </span>);
<span style="color: brown;">14 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@wikis</span> = <span style="color: magenta;">qw(</span><span style="color: magenta;">Usemod Twiki Template Kwiki Confluence Moinmoin Tiddlywiki Mediawiki Textile</span><span style="color: magenta;">)</span>;
<span style="color: brown;">15 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%formats</span> = (
<span style="color: brown;">16 </span> ( <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">"</span><span style="color: magenta;">Pod::Simple::</span><span style="color: darkcyan;">$_</span><span style="color: magenta;">"</span> } <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%content_types</span> ),
<span style="color: brown;">17 </span> ( <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">"</span><span style="color: magenta;">Pod::Simple::Wiki::</span><span style="color: darkcyan;">$_</span><span style="color: magenta;">"</span> } <span style="color: darkcyan;">@wikis</span> )
<span style="color: brown;">18 </span>);
<span style="color: brown;">19 </span>
<span style="color: brown;">20 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$q</span> = <span style="color: brown;"><b>new</b></span> CGI;
<span style="color: brown;">21 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$filename</span> = Pod::Simple::Search-><span style="color: brown;"><b>new</b></span>->inc(<span style="color: magenta;">1</span>)->find( <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">pod</span><span style="color: magenta;">"</span>) );
<span style="color: brown;">22 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$format</span> = <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">format</span><span style="color: magenta;">"</span>) || <span style="color: magenta;">"</span><span style="color: magenta;">HTML</span><span style="color: magenta;">"</span>;
<span style="color: brown;">23 </span>given (<span style="color: darkcyan;">$format</span>) {
<span style="color: brown;">24 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">source</span><span style="color: magenta;">"</span>) {
<span style="color: brown;">25 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/plain</span><span style="color: magenta;">"</span>);
<span style="color: brown;">26 </span> <span style="color: brown;"><b>open</b></span> <span style="color: darkcyan;">POD</span>, <span style="color: darkcyan;">$filename</span>;
<span style="color: brown;">27 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$_</span> <span style="color: brown;"><b>while</b></span> (<span style="color: darkcyan;"><POD></span>);
<span style="color: brown;">28 </span> }
<span style="color: brown;">29 </span> when (<span style="color: magenta;">'</span><span style="color: magenta;">HTML</span><span style="color: magenta;">'</span>) {
<span style="color: brown;">30 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$parser</span> = Pod::Simple::HTML-><span style="color: brown;"><b>new</b></span>;
<span style="color: brown;">31 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/html</span><span style="color: magenta;">"</span>);
<span style="color: brown;">32 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->perldoc_url_prefix</span>( <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->url</span>( -<span style="color: magenta;">path_info </span>=> <span style="color: magenta;">1</span> ) . <span style="color: magenta;">"</span><span style="color: magenta;">?pod=</span><span style="color: magenta;">"</span> );
<span style="color: brown;">33 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$footer</span> = <span style="color: magenta;">"</span><span style="color: magenta;"><hr></span><span style="color: magenta;">"</span>
<span style="color: brown;">34 </span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;"> </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>map</b></span> { make_link(<span style="color: darkcyan;">$_</span>) } <span style="color: magenta;">"</span><span style="color: magenta;">source</span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%content_types</span> )
<span style="color: brown;">35 </span> . <span style="color: magenta;">"</span><span style="color: magenta;"> | Wiki formats: </span><span style="color: magenta;">"</span>
<span style="color: brown;">36 </span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;"> </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>map</b></span> { make_link(<span style="color: darkcyan;">$_</span>) } <span style="color: darkcyan;">@wikis</span> );
<span style="color: brown;">37 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->html_footer</span>(qq[\n<!-- end doc -->\n\n<span style="color: darkcyan;">$footer</span></body></html>\n]);
<span style="color: brown;">38 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->output_fh</span>(*STDOUT);
<span style="color: brown;">39 </span> <span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->parse_file</span>(<span style="color: darkcyan;">$filename</span>);
<span style="color: brown;">40 </span> }
<span style="color: brown;">41 </span> when (<span style="color: darkcyan;">%formats</span>) {
<span style="color: brown;">42 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$class</span> = <span style="color: darkcyan;">$formats{$format}</span>;
<span style="color: brown;">43 </span> <span style="color: brown;"><b>eval</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">require </span><span style="color: darkcyan;">$class</span><span style="color: magenta;">"</span>;
<span style="color: brown;">44 </span> <span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>( <span style="color: darkcyan;">$content_types{$format}</span> || <span style="color: magenta;">"</span><span style="color: magenta;">text/plain</span><span style="color: magenta;">"</span> );
<span style="color: brown;">45 </span> <span style="color: darkcyan;">$class</span><span style="color: darkcyan;">->filter</span>(<span style="color: darkcyan;">$filename</span>);
<span style="color: brown;">46 </span> }
<span style="color: brown;">47 </span> default {
<span style="color: brown;">48 </span> <span style="color: brown;"><b>die</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">Formato desconocido '</span><span style="color: darkcyan;">$format</span><span style="color: magenta;">'</span><span style="color: magenta;">"</span>);
<span style="color: brown;">49 </span> }
<span style="color: brown;">50 </span>}
<span style="color: brown;">51 </span>
<span style="color: brown;">52 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">make_link </span>{
<span style="color: brown;">53 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$fmt</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">54 </span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->a</span>( { <span style="color: magenta;">href </span>=> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->url</span>( -<span style="color: magenta;">path_info </span>=> <span style="color: magenta;">1</span>, -<span style="color: magenta;">query </span>=> <span style="color: magenta;">1</span> ) . <span style="color: magenta;">"</span><span style="color: slateblue;">\&</span><span style="color: magenta;">format=</span><span style="color: darkcyan;">$fmt</span><span style="color: magenta;">"</span> }, <span style="color: darkcyan;">$fmt</span> );
<span style="color: brown;">55 </span>}
</pre>Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-32673974658424538942009-11-15T19:40:00.002-04:302009-11-15T22:12:01.715-04:30Perl documetantion tools[<a href="http://perliscopio.blogspot.com/2009/11/herramientas-de-documentacion-en-perl.html">Original spanish source</a>]<br />
Perl has its own documentation format called POD (Plain Old Documentation), this format is structured and was specifically designed to be easily manipulated. POD is used not only as a tool for documenting Perl, but as Wiki language and even for book writing.<br />
<br />
In perl the most popular tool for reading the documentation is <a href="http://perldoc.perl.org/perldoc.html">perldoc</a>, that works in the same way that the unix <a href="http://linux.die.net/man/1/man">man</a>(1), to show the IO::File module documentation:<br />
<br />
$ perldoc IO::Handle<br />
<br />
we may get the manuals in LaTeX o html format just by adding options to perldoc:<br />
<br />
$ perldoc -T -o LaTeX IO::Handle > IO::Handle.tex<br />
$ perldoc -T -o html IO::Handle > IO::Handle.html<br />
<br />
If we see the generated HTML you will realize that the links point to the CPAN (they are not relative to the processed file), this is just the perldoc way, but there are <a href="http://search.cpan.org/search?query=pod">hundreds of modules to process POD</a>, allowing advanced manipulation and conversions to HTML, XML, LaTeX, texto and DocBook, among others.<br />
<br />
When you need more control over the generation of documents, you can use other tools such as: pod2html and pod2latex that create documents based on multiple POD files which are processed together, for example to make a book where each chapter is stored in a different POD file.<br />
<br />
If you need total control over the conversion process, you can always program using the modules from the CPAN, one of the easiest to use is Pod::Simple, which offers several predefined conversions, for example you may generate HTML in a CGI application with ease:<br />
<br />
<pre><span style="color: brown;">1 </span><span style="color: #a020f0;">use </span>CGI;
<span style="color: brown;">2 </span><span style="color: #a020f0;">use </span>Pod::Simple::HTML;
<span style="color: brown;">3 </span>
<span style="color: brown;">4 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$q</span> = <span style="color: brown;"><b>new</b></span> CGI;
<span style="color: brown;">5 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$parser</span> = Pod::Simple::HTML-><span style="color: brown;"><b>new</b></span>;
<span style="color: brown;">6 </span><span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->output_fh</span>(*STDOUT);
<span style="color: brown;">7 </span>
<span style="color: brown;">8 </span><span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/html</span><span style="color: magenta;">"</span>);
<span style="color: brown;">9 </span><span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->parse_file</span>(<span style="color: magenta;">"</span><span style="color: magenta;">/usr/share/perl/5.8/IO/File.pod</span><span style="color: magenta;">"</span>);
</pre><br />
This program initializes the CGI and Pod::Simple::HTML objects (lines 4 to 6), sends the HTTP headers (line 6) and finally sends the converted POD as an HTML document (line 9).<br />
<br />
In this case you must know the exact name of the POD file you want to send, however if you want to know the name of a file containing information about a particular module, you should look for it, but where?. The answer is: in the same places where perl looks for its modules and programs.<br />
<br />
The @INC variable contains the places where perl looks for modules used in programs, this is a combination of predefined locations when compiling perl, the contents of the PERL5LIB environment variable and places specified with "use lib" in the perl code. On the other hand when you must run a program, perl will search for it along the PATH environment variable, so to find the file containing the POD for a Perl module or program you can use a function like find_pod shown below:<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 2 </span><span style="color: #a020f0;">use </span>Env::Path;
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>File::Spec::Functions;
<span style="color: brown;"> 4 </span>
<span style="color: brown;"> 5 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">find_pod</span>
<span style="color: brown;"> 6 </span>{
<span style="color: brown;"> 7 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$module</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;"> 8 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@module_path</span> = <span style="color: brown;"><b>split</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">::</span><span style="color: magenta;">"</span>, <span style="color: darkcyan;">$module</span>);
<span style="color: brown;"> 9 </span> <span style="color: brown;"><b>for</b></span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$dir</span> ( <span style="color: darkcyan;">@INC</span>, Env::Path->PATH->List ) {
<span style="color: brown;">10 </span> <span style="color: brown;"><b>for</b></span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$ext</span> ( <span style="color: magenta;">''</span>, <span style="color: magenta;">'</span><span style="color: magenta;">.pod</span><span style="color: magenta;">'</span>, <span style="color: magenta;">'</span><span style="color: magenta;">.pm</span><span style="color: magenta;">'</span>, <span style="color: magenta;">'</span><span style="color: magenta;">.pl</span><span style="color: magenta;">'</span> ) {
<span style="color: brown;">11 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$name</span> = catfile(<span style="color: darkcyan;">$dir</span>, <span style="color: darkcyan;">@module_path</span>) . <span style="color: darkcyan;">$ext</span>;
<span style="color: brown;">12 </span> <span style="color: brown;"><b>return</b></span> <span style="color: darkcyan;">$name</span> <span style="color: brown;"><b>if</b></span> <span style="color: brown;"><b>-e</b></span> <span style="color: darkcyan;">$name</span>;
<span style="color: brown;">13 </span> }
<span style="color: brown;">14 </span> }
<span style="color: brown;">15 </span> <span style="color: brown;"><b>return</b></span> <span style="color: brown;"><b>undef</b></span>;
<span style="color: brown;">16 </span>}
<span style="color: brown;">17 </span>
<span style="color: brown;">18 </span><span style="color: brown;"><b>print</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">Nombre: </span><span style="color: magenta;">"</span>, find_pod(<span style="color: darkcyan;">@ARGV</span>), <span style="color: magenta;">"</span><span style="color: slateblue;">\n</span><span style="color: magenta;">"</span>;
</pre><br />
This function receives the name of the module or program, then split the names on "::" and finally iterates all directories in @INC and the system's PATH environment variable, which is converted to a list using "<code>Env::Path->PATH->List</code>" (line 9), then for each directory it looks for the names alone and the arguments with the extensions: pod, pm and pl, the first match found is returned or undef is none is found.<br />
<br />
I used "<code>Env::Path</code>" to get the system PATH in a portable way and "<code>File::Spec::Functions</code>" which imports "<code>catfile</code>" to make pathnames also portable between Unix and Windows.<br />
<br />
But I made this just for fun, because CPAN already has something better: "<code>Pod::Simple::Search</code>", which is well done and can be easily installed from your favorite mirror, this is way more flexible than my toy subroutine, and I will use it to improve the code allowing to show PODs by module or program name:<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span><span style="color: #a020f0;">use </span>CGI;
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Pod::Simple::HTML;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Pod::Simple::Search;
<span style="color: brown;"> 5 </span>
<span style="color: brown;"> 6 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$q</span> = <span style="color: brown;"><b>new</b></span> CGI;
<span style="color: brown;"> 7 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$parser</span> = Pod::Simple::HTML-><span style="color: brown;"><b>new</b></span>;
<span style="color: brown;"> 8 </span><span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->output_fh</span>(*STDOUT);
<span style="color: brown;"> 9 </span>
<span style="color: brown;">10 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$filename</span> = Pod::Simple::Search-><span style="color: brown;"><b>new</b></span>->inc(<span style="color: magenta;">1</span>)->find(<span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">pod</span><span style="color: magenta;">"</span>));
<span style="color: brown;">11 </span><span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/html</span><span style="color: magenta;">"</span>);
<span style="color: brown;">12 </span><span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->parse_file</span>(<span style="color: darkcyan;">$filename</span>);
</pre><br />
If you have a web server already configured, just copy the file in the CGI-BIN directory with the name "perldocweb" and add executable privileges, you may test it by using the following URL in your favorite browser:<br />
<br />
<pre>http://localhost/cgi-bin/perldocweb?pod=IO::File
</pre><br />
it will show the IO::File manual, although the links still point to CPAN.<br />
<br />
To fix the links we must set the <code>perldoc_url_prefix</code> to point to our documentation server, I will use CGI's url() method as shown in line 12, which returns the full script URL (without the query):<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span><span style="color: #a020f0;">use </span>CGI;
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Pod::Simple::HTML;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Pod::Simple::Search;
<span style="color: brown;"> 5 </span>
<span style="color: brown;"> 6 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$q</span> = <span style="color: brown;"><b>new</b></span> CGI;
<span style="color: brown;"> 7 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$parser</span> = Pod::Simple::HTML-><span style="color: brown;"><b>new</b></span>;
<span style="color: brown;"> 8 </span><span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->output_fh</span>(*STDOUT);
<span style="color: brown;"> 9 </span>
<span style="color: brown;">10 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$filename</span> = Pod::Simple::Search-><span style="color: brown;"><b>new</b></span>->inc(<span style="color: magenta;">1</span>)->find(<span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->param</span>(<span style="color: magenta;">"</span><span style="color: magenta;">pod</span><span style="color: magenta;">"</span>));
<span style="color: brown;">11 </span><span style="color: brown;"><b>print</b></span> <span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->header</span>(<span style="color: magenta;">"</span><span style="color: magenta;">text/html</span><span style="color: magenta;">"</span>);
<span style="color: brown;">12 </span><span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->perldoc_url_prefix</span>(<span style="color: darkcyan;">$q</span><span style="color: darkcyan;">->url</span>(-<span style="color: magenta;">path_info</span>=><span style="color: magenta;">1</span>) . <span style="color: magenta;">"</span><span style="color: magenta;">?pod=</span><span style="color: magenta;">"</span>);
<span style="color: brown;">13 </span><span style="color: darkcyan;">$parser</span><span style="color: darkcyan;">->parse_file</span>(<span style="color: darkcyan;">$filename</span>);
</pre><br />
So far so good, a fairly simple documentation server in just 13 lines, the next time I will convert POD to many formats, meanwhile you can install <a href="http://search.cpan.org/perldoc?Pod::Server">Pod::Server</a> which shows a better and more elegant way to do a documentation server.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-33896039183096702322009-11-05T00:51:00.001-04:302009-11-06T11:01:51.351-04:30Perl error handling[<a href="http://perliscopio.blogspot.com/2009/11/manejando-errores-en-perl.html">Original spanish article</a>]<br />
<br />
Exception handling in Perl is a bit different than we are probably used to, particularly Perl has no try/catch/throw as some other languages, but that doesn't mean that it can't do exception handling, Perl can catch and handle exceptions as well as any other language but it has a slightly different structure.<br />
<br />
Exception handling in Perl is based on the use of the <code>eval</code> operator, which allows the evaluation of code and error catching, when <code>eval</code> receives a string, it compiles the code inside it and executes it, however any error that happens in the code, from the compilation to execution would abort the only the <code>eval</code> while our program will continue its execution, for example:<br />
<br />
<pre><span style="color: brown;">1 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;">2 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$result</span> = <span style="color: brown;"><b>eval</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">5 / 0</span><span style="color: magenta;">"</span> );
<span style="color: brown;">3 </span>say <span style="color: magenta;">"</span><span style="color: magenta;">El resultado es: </span><span style="color: darkcyan;">$result</span><span style="color: magenta;">"</span>;
</pre><br />
Although the program works, the result of <code>eval</code> is undef, because division by zero prevented the return of any value, this also causes a warning on line 3 about the use of an uninitialized value.<br />
<br />
What we need to know is whether the <code>eval</code> was successful or not, and that information is in the special variable $@ (also known as $EVAL_ERROR if we use the module English).<br />
<br />
<pre><span style="color: brown;">1 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;">2 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$result</span> = <span style="color: brown;"><b>eval</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">5 / 0</span><span style="color: magenta;">"</span> );
<span style="color: brown;">3 </span><span style="color: brown;"><b>if</b></span> ( <span style="color: darkcyan;">$@</span> ) {
<span style="color: brown;">4 </span> say <span style="color: magenta;">"</span><span style="color: magenta;">Ooops: </span><span style="color: darkcyan;">$@</span><span style="color: magenta;">"</span>;
<span style="color: brown;">5 </span>}
<span style="color: brown;">6 </span><span style="color: brown;"><b>else</b></span> {
<span style="color: brown;">7 </span> say <span style="color: magenta;">"</span><span style="color: magenta;">El resultado es: </span><span style="color: darkcyan;">$result</span><span style="color: magenta;">"</span>;
<span style="color: brown;">8 </span>}</pre><br />
The problem with this solution is that the code within the string is not checked at compile time, because it is compiled at run time, and although this is extremely powerful, in most cases we are just interested in the <code>eval</code>'s ability to catch errors, the second form of <code>eval</code>, takes a block of code that is checked during compilation of the program, and we can use it like this:<br />
<br />
<pre><span style="color: brown;">2 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$result</span> = <span style="color: brown;"><b>eval</b></span> { <span style="color: magenta;">5</span> / <span style="color: magenta;">0</span> };</pre><br />
In this form of <code>eval</code>, the braces ({}) mark the catch block where exception handling is required and returns the last expression of this block, or undef if an error occurs while executing it (because it has already been compiled altogether with the containing program). <br />
<br />
The last primitive we need to complete Perl's exception system is die, which allows to throw an exception, this routine receives a value that is assigned to the variable $@, so we could make a program that throws an exception like this:<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 2 </span><span style="color: #a020f0;">use </span>IO::File;
<span style="color: brown;"> 3 </span>
<span style="color: brown;"> 4 </span><span style="color: brown;"><b>eval</b></span> {
<span style="color: brown;"> 5 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$fh</span> = IO::File-><span style="color: brown;"><b>new</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">AlgunArchivo.txt</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">r</span><span style="color: magenta;">"</span>);
<span style="color: brown;"> 6 </span> <span style="color: brown;"><b>die</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">No se puede abrir</span><span style="color: magenta;">"</span>) <span style="color: brown;"><b>unless</b></span> <span style="color: darkcyan;">$fh</span>;
<span style="color: brown;"> 7 </span>};
<span style="color: brown;"> 8 </span><span style="color: brown;"><b>if</b></span> ( <span style="color: darkcyan;">$@</span> ) {
<span style="color: brown;"> 9 </span> say <span style="color: magenta;">"</span><span style="color: magenta;">Ooops: </span><span style="color: darkcyan;">$@</span><span style="color: magenta;">"</span>;
<span style="color: brown;">10 </span>}</pre><br />
Some people may think that this way of capturing exceptions is <a href="http://perliscope.blogspot.com/2009/08/archaic-perl.html">archaic</a>, however, it is as good as any other, and with the facilities of Perl could be used as basis for implementing a structure similar to that of other languages, something like try/catch. As I've already said on other articles Perl is an excellent language for implementing new features based on the language primitives, and I will roll my own version of try/catch just for fun:<br />
<code><br />
<span style="color: brown;"> 1 </span><span style="color: brown;"><b>use </b></span>Modern::Perl;<br />
<span style="color: brown;"> 2 </span><span style="color: brown;"><b>use </b></span>IO::File;<br />
<span style="color: brown;"> 3 </span><br />
<span style="color: brown;"> 4 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">try</span><span style="color: darkcyan;">(&amp;)</span><span style="color: darkcyan;"> </span>{<br />
<span style="color: brown;"> 5 </span> <span style="color: brown;"><b>eval</b></span> { <span style="color: brown;"><b>shift</b></span>-<span style="color: darkcyan;">&gt</span>;() };<br />
<span style="color: brown;"> 6 </span>}<br />
<span style="color: brown;"> 7 </span><br />
<span style="color: brown;"> 8 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">catch</span><span style="color: darkcyan;">(&amp;)</span><span style="color: darkcyan;"> </span>{<br />
<span style="color: brown;"> 9 </span> <span style="color: brown;"><b>if</b></span> ( <span style="color: darkcyan;">$@</span> ) {<br />
<span style="color: brown;">10 </span> <span style="color: brown;"><b>local</b></span> <span style="color: darkcyan;">$_</span> = <span style="color: darkcyan;">$@</span>;<br />
<span style="color: brown;">11 </span> <span style="color: brown;"><b>shift</b></span>-<span style="color: darkcyan;">&gt</span>;();<br />
<span style="color: brown;">12 </span> }<br />
<span style="color: brown;">13 </span>}<br />
<span style="color: brown;">14 </span><br />
<span style="color: brown;">15 </span>try {<br />
<span style="color: brown;">16 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$fh</span> = IO::File-<span style="color: darkcyan;">&gt</span>;<span style="color: brown;"><b>new</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">AlgunArchivo.txt</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">r</span><span style="color: magenta;">"</span> );<br />
<span style="color: brown;">17 </span> <span style="color: brown;"><b>die</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">No se puede abrir</span><span style="color: magenta;">"</span>) <span style="color: brown;"><b>unless</b></span> <span style="color: darkcyan;">$fh</span>;<br />
<span style="color: brown;">18 </span>};<br />
<span style="color: brown;">19 </span>catch {<br />
<span style="color: brown;">20 </span> say <span style="color: magenta;">"</span><span style="color: magenta;">Ooops: </span><span style="color: darkcyan;">$_</span><span style="color: magenta;">"</span>;<br />
<span style="color: brown;">21 </span>};<br />
</code><br />
<br />
Here the Perl prototype (<code>&</code>) allows subroutines <code>try</code> and <code>catch</code> to receive a closure, but the prototype will allow to remove the sub declaration, pretending that <code>try</code> and <code>catch</code> are control structures with an associated code block, while they are just plain subroutines whose first parameter is a closure, and thus can be invoked, at line 5 the first argument is removed (with <code>shift</code>) and used to execute the closure (with <code>->()</code>) within the <code>eval</code>, so any exception inside the closure code will abort the eval and exit the <code>try</code> subroutine.<br />
<br />
When used after a <code>try</code>, <code>catch</code> localizes any value of <code>$@</code> in <code>$_</code> and runs the closure, which can use <code>$_</code> as the value of the exception.<br />
<br />
To make an extension that allows to use the newly created structures, we just make a new module, I will call <code>MyTryCatch</code> and should be in the file "MyTryCatch.pm":<br />
<br />
<code><br />
<span style="color: brown;"> 1 </span><span style="color: brown;"><b>package</b></span><span style="color: seagreen;"><b> MyTryCatch;</b></span><br />
<span style="color: brown;"> 2 </span><br />
<span style="color: brown;"> 3 </span><span style="color: brown;"><b>use </b></span>Exporter;<br />
<span style="color: brown;"> 4 </span><br />
<span style="color: brown;"> 5 </span><span style="color: brown;"><b>our</b></span> <span style="color: darkcyan;">$VERSION</span> = <span style="color: magenta;">"</span><span style="color: magenta;">1.000</span><span style="color: magenta;">"</span>;<br />
<span style="color: brown;"> 6 </span><span style="color: brown;"><b>our</b></span> <span style="color: darkcyan;">@EXPORT_OK</span> = <span style="color: magenta;">qw(</span><span style="color: magenta;"> try catch </span><span style="color: magenta;">)</span>;<br />
<span style="color: brown;"> 7 </span><span style="color: brown;"><b>our</b></span> <span style="color: darkcyan;">@EXPORT</span> = <span style="color: darkcyan;">@EXPORT_OK</span>;<br />
<span style="color: brown;"> 8 </span><br />
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">try</span><span style="color: darkcyan;">(&amp;)</span><span style="color: darkcyan;"> </span>{<br />
<span style="color: brown;">10 </span> <span style="color: brown;"><b>eval</b></span> { <span style="color: brown;"><b>shift</b></span>-<span style="color: darkcyan;">&gt</span>;() };<br />
<span style="color: brown;">11 </span>}<br />
<span style="color: brown;">12 </span><br />
<span style="color: brown;">13 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">catch</span><span style="color: darkcyan;">(&amp;)</span><span style="color: darkcyan;"> </span>{<br />
<span style="color: brown;">14 </span> <span style="color: brown;"><b>if</b></span> ( <span style="color: darkcyan;">$@</span> ) {<br />
<span style="color: brown;">15 </span> <span style="color: brown;"><b>local</b></span> <span style="color: darkcyan;">$_</span> = <span style="color: darkcyan;">$@</span>;<br />
<span style="color: brown;">16 </span> <span style="color: brown;"><b>shift</b></span>-<span style="color: darkcyan;">&gt</span>;();<br />
<span style="color: brown;">17 </span> }<br />
<span style="color: brown;">18 </span>}</code><code><br />
<span style="color: brown;">19</span></code><br />
<code><span style="color: brown;">20 </span><span style="color: magenta;">1</span>;<br />
</code><br />
Thus we may use the new structure in any program easily:<br />
<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 2 </span><span style="color: #a020f0;">use </span>IO::File;
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>MyTryCatch;
<span style="color: brown;"> 4 </span>
<span style="color: brown;"> 5 </span>try {
<span style="color: brown;"> 6 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$fh</span> = IO::File-><span style="color: brown;"><b>new</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">AlgunArchivo.txt</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">r</span><span style="color: magenta;">"</span> );
<span style="color: brown;"> 7 </span> <span style="color: brown;"><b>die</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">No se puede abrir</span><span style="color: magenta;">"</span>) <span style="color: brown;"><b>unless</b></span> <span style="color: darkcyan;">$fh</span>;
<span style="color: brown;"> 8 </span>};
<span style="color: brown;"> 9 </span>catch {
<span style="color: brown;">10 </span> say <span style="color: magenta;">"</span><span style="color: magenta;">Ooops: </span><span style="color: darkcyan;">$_</span><span style="color: magenta;">"</span>;
<span style="color: brown;">11 </span>};</pre><br />
The primitives just created have some defects, for example the allow the use of a catch without a catch, a return statement within a try or catch block will exit the block and not the enclosing subroutine, among others. However with a bit more effort we could make an extension that declares a structure that behaves better.<br />
<br />
There are several CPAN modules that let to do exceptions handling from the simplest <a href="http://search.cpan.org/perldoc?Try::Tiny">Try::Tiny</a>, who suffers from some drawbacks of MyTryCatch to the most complex <a href="http://search.cpan.org/perldoc?TryCatch">TryCatch</a> that uses deep magic from <a href="http://search.cpan.org/perldoc?Devel::Declare">Devel::Declare</a> to make an exception handling structure with almost anything you can imagine.<br />
<br />
If your requirements are not demanding my recommendation is to use Try::Tiny, it is tiny, has almost no dependencies and is easy to install, on the other hand if you want an exception handling system that does everything, you do not mind much about resource consumption and have the patience to install dozens of modules, you can use TryCatch.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com2tag:blogger.com,1999:blog-699609172043710797.post-69474236672318272672009-10-24T10:18:00.000-04:302009-10-24T10:18:35.925-04:30Language evolution[<a href="http://perliscopio.blogspot.com/2009/10/evolucion-de-lenguajes.html">Spanish source</a>]<br />
Perhaps you have notice that I have not written very much lately, the reason was that I had to devote full time to an urgent migration. <br />
<br />
The system in question belongs to the client who hired me to develop a web application, which incidentally was my first application of this style back in 1998. <br />
<br />
At that time I was giving my first steps with Perl, but somehow people convinced me that the application should be developed in PHP, I slowly realized that PHP was not flexible enough, and end up doing several Perl programs that implement the most of the functionality, yet the entire application interface remained in PHP. <br />
<br />
During this project, I learned that Perl was much more versatile, powerful and fun than PHP (3), and if I had not been persuaded, would probably have found CGI.pm, the entire application would be in Perl and I would not have a story to tell. <br />
<br />
At the start of the migration process, it occurred to me that it would be easier to do interface migration first, because I thought that being the simplest part of the application could be easily migrated to PHP5, this was far from reality, because nothing worked as it should. <br />
<br />
I understand that everything evolves, but programs didn't even compile, some APIs have changed enough to warrant a complete review of all source code, and of course the application was a mess, what else could it be?, At the time there wasn't available a library of templates, access to the database was done with the horrible library functions for PHP3, and the entire application is a monument to the ASP style programming, where the view, model and controller were completely integrated, as if they had gone through a blender. <br />
<br />
The truth is that it was easier to compile PHP3 for the new operating system than trying to migrate the code to PHP5, in that matter I wish to thank Debian and particularly archive.debian.org, because it may be one of the few places on the planet that still keep PHP3 source code, because the language's community has a policy of withdrawing old sources from the Internet. <br />
<br />
Having overcome the problem (ie PHP), I had nightmares about the pile of Perl 5 code that would not work at all in the new Perl 5.10, so I resigned and started to copy and run all files.<br />
The first thing broken was DBI, in fact the connection string to the database was using a format that I did not even remember it had existed: <br />
<pre><code>
DBI-> connect ( "dbi: Pg: dbname = mydb@myhost.com", "user", "pass");
</code></pre>which I changed to the current syntax: <br />
<pre><code>
DBI-> connect ( "dbi: Pg: dbname = mydb, host = myhost.com", "user", "pass");
</code></pre>I tried the program again and it worked, I proceeded to try another program and it worked, and the trend continued, program by program and couldn't find any faults. <br />
A decade of language and the CPAN evolution and almost everithing worked at once, I was amazed (and of course pleased).<br />
<br />
By contrasting the Perl and PHP evolution I can appreciate that while the former has acquired a wealth of features such as new language constructs, several concurrency implementations, event-driven, threads and corrutines, new abstractions to facilitate and improve OOP which allow the programmer to choose between several object-oriented systems, significant advances in the area of meta programming, and some others, the later has achieved basically a system of OOP, and still it is more incompatible than Perl.<br />
<br />
The question is: why this radical difference?, especially when it is said that there are many more solutions ready in PHP than in Perl and then there should be more development effort in former that the later.<br />
<br />
You may have the impression that I am bashing about PHP, but I am not, PHP was just the trigger that made me think about the problem, but if we look to other languages, will probably reach similar conclusions, for example: how much did Python language evolved in the last decade?, would a 10 year old program still work in the current envirnment?, what about Java?. My bet is that Perl beats them both on these fronts.<br />
<br />
Although Perl is a <a href="http://en.wikipedia.org/wiki/Worse_is_better">New Jersey solution</a>, the language itself is heavily influenced by Lisp, <a href="http://en.wikipedia.org/wiki/Worse_is_better">a MIT solution</a>, although one can argue about the complexity of the syntax of Perl, the fact is that the semantics of their operations is consistent enough and extremely versatile, allowing modules extending the language, so you can experiment with new features without introducing them into the interpreter.<br />
<br />
Other programming environments have very good tools that greatly facilitate the implementation of compilers, but the complexity in the implementation of any language extension by preprocessing the language limits the development of such extensions.<br />
<br />
Moreover, the lack of integration with the compiler, forces the user to introduce complexity in the construction of software, execution of pre-compilers, handling of temporary files, and others, that become a nightmare particularly in dynamic environments, imagine that to load a Moose module, you should need to run the Moose preprocessor, and then load the module resulting from the compilation, it would be really annoying, Perl has mechanisms that allow the Moose compiler to run automatically, accessing the source code and returning the modified code to the Perl compiler for the final stage of compilation, and you all you need to do is: use Moose; at the program start.<br />
<br />
The problems described above limit the adoption of external extensions to the language, restricting the evolution through extensions, which is the easiest way to evolve a language. In this sense Perl is a lot like Lisp, and most of the evolution of language is achieved by adding external modules from the CPAN. Today there are extensions that implement various structures such as try/catch, adding the ability to declare the parameters in the declaration of subroutines, and many other goodies that are not part of language.<br />
<br />
With respect to compatibility, there are two factors to take into account: the compatibility of the libraries and the language itself.<br />
The language compatibility is maintained using pragmas, which for Perl are almost the same as any CPAN module (or it seems so, from the perspective of a programmer), so when the language changes new pragmas are added. For example the new features of Perl 5.10 are activated using a pragma.<br />
<br />
The greatest Perl incompatibility occurred in the last decade is the elimination of pseudohashes, and to minimize the problems mechanisms were created to facilitate the migration of existing code (use fields) and the deprecated pseudohash feature was keep around for about 5 years. This illustrates how the community is committed to maintain compatibility with existing code.<br />
<br />
The community has recently adopted the term DarkPAN, which is all the code is written in Perl, that is not publicly available, but lies hidden in thousands of systems that people do not even know have been written in Perl (the one in this story appears to be written in PHP), and although many people prefer to modernize the Perl platform obviating the DarkPAN, community generally thinks that this is not the best policy.<br />
<br />
In the universe dark matter accounts for most of the mass, and we do not know if DarkPAN outweighs the CPAN, but we can see some side effects, for example, though there seems more systems written in PHP, there are many more job offerings for Perl, and DarkPAN may be the cause. <br />
<br />
The truth is that all that code which drives many business is there because it works, and because it can be maintained over time with less effort than similar code developed on other platforms. <br />
<br />
The most impressive fact is that today we have a very modern platform compatible with a decade old code, with libraries so easy to use, modern and powerful such as Moose, Devel:: Declare and Catalyst, which are the envy of other languages' developers.<br />
<br />
So if you want to program in a simple, modern, powerful and enduring, plataform the choice is clear: Perl.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com6tag:blogger.com,1999:blog-699609172043710797.post-26692470043562414882009-10-14T23:25:00.002-04:302009-10-14T23:42:29.505-04:30Statistic Calculator: Final Console Application[<a href="http://perliscopio.blogspot.com/2009/10/calculadora-estadistica-toques-finales.html">Spanish original</a>]<br />
In the <a href="http://perliscope.blogspot.com/2009/09/statistic-calculator-user-friendly.html">last article</a> we left pending to make our interpreter to recognize parameters and be able to print any return value from the Statistics::Descriptive functions.<br />
First we should define how to delimit commands and parameters, the easiest way to do it is like the unix shell does, using whitespace to delimit both, so once you get a line of commands:<br />
<pre><span style="color: brown;">34 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>//</b></span>; <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: magenta;">$</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">35 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@args</span> = <span style="color: brown;"><b>split</b></span><span style="color: brown;"><b> /</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>/</b></span>, <span style="color: darkcyan;">$command</span>;
<span style="color: brown;">36 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$oper</span> = looks_like_number( <span style="color: darkcyan;">$args[</span><span style="color: magenta;">0</span><span style="color: darkcyan;">]</span> ) ? <span style="color: magenta;">"</span><span style="color: magenta;">add_data</span><span style="color: magenta;">"</span> : <span style="color: brown;"><b>shift</b></span> <span style="color: darkcyan;">@args</span>;</pre>spaces are removed at the beginning and end (34), split all the elements separated by one or more white (35), and get the operation to perform (36) which is usually the first element, except when a number is read, in which case the implicit operation is "add_date". After these operations the operation to be performed is in $oper and its arguments are in @args, so it only remains to apply the operation: <br />
<br />
<pre><span style="color: brown;">38 </span> when (<span style="color: darkcyan;">%FUNCS</span>) { apply( <span style="color: darkcyan;">$oper</span>, <span style="color: darkcyan;">@args</span> ) }</pre>The routine in charge of the implementation of the operation must get the arguments (26), assess the operation in context list (27), why should be that in list context?, to allow operations like "percentile" return multiple values.<br />
La rutina a cargo de la aplicación de la operación debe obtener los argumentos (26), evaluar la operación en contexto lista (27), ¿por qué en contexto lista?, para permitir operaciones como "percentile" que produce múltiples valores.<br />
<br />
Once the value is calculated, we had to check whether it is worth printing, so we simply return if @result is empty (28), or if you have a single element but is not defined or empty string (29). <br />
To print complex values I will use the YAML format, because it is very readable and perl has a very good YAML module available from CPAN. <br />
So depending on the number of elements in @result will print the first element or or the entire array converted to YAML text (30). <br />
The calculator then console looks like:<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Scalar::Util <span style="color: magenta;">qw(</span><span style="color: magenta;"> looks_like_number </span><span style="color: magenta;">)</span>;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>Statistics::Descriptive;
<span style="color: brown;"> 6 </span><span style="color: #a020f0;">use </span>Pod::Perldoc;
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use </span>Term::ReadLine;
<span style="color: brown;"> 8 </span><span style="color: #a020f0;">use </span>YAML;
<span style="color: brown;"> 9 </span>
<span style="color: brown;">10 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$term</span> = <span style="color: brown;"><b>new</b></span> Term::ReadLine <span style="color: magenta;">'</span><span style="color: magenta;">Statistic Calculator</span><span style="color: magenta;">'</span>;
<span style="color: brown;">11 </span>
<span style="color: brown;">12 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%FUNCS</span> = <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">1</span> } <span style="color: magenta;">qw(</span><span style="color: magenta;"> sum mean count variance standard_deviation</span>
<span style="color: brown;">13 </span><span style="color: magenta;"> min mindex max maxdex sample_range median harmonic_mean geometric_mean</span>
<span style="color: brown;">14 </span><span style="color: magenta;"> mode trimmed_mean clear add_data percentile quantile least_squares_fit</span>
<span style="color: brown;">15 </span><span style="color: magenta;"> frequency_distribution_ref frequency_distribution</span><span style="color: magenta;">)</span>;
<span style="color: brown;">16 </span>
<span style="color: brown;">17 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@COMMANDS</span> = <span style="color: magenta;">qw(</span><span style="color: magenta;"> exit quit help man </span><span style="color: magenta;">)</span>;
<span style="color: brown;">18 </span>
<span style="color: brown;">19 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">help </span>{ say <span style="color: magenta;">"</span><span style="color: magenta;">Comandos: </span><span style="color: magenta;">"</span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">, </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>sort</b></span> <span style="color: darkcyan;">@COMMANDS</span>, <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%FUNCS</span> ) }
<span style="color: brown;">20 </span>
<span style="color: brown;">21 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">man </span>{ Pod::Perldoc-><span style="color: brown;"><b>new</b></span>( <span style="color: magenta;">args </span>=> <span style="color: darkcyan;">\@_</span> )->process }
<span style="color: brown;">22 </span>
<span style="color: brown;">23 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$s</span> = Statistics::Descriptive::Full-><span style="color: brown;"><b>new</b></span>();
<span style="color: brown;">24 </span>
<span style="color: brown;">25 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">apply </span>{
<span style="color: brown;">26 </span> <span style="color: brown;"><b>my</b></span> ( <span style="color: darkcyan;">$oper</span>, <span style="color: darkcyan;">@args</span> ) = <span style="color: darkcyan;">@_</span>;
<span style="color: brown;">27 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@result</span> = <span style="color: darkcyan;">$s</span>-><span style="color: darkcyan;">$oper</span>(<span style="color: darkcyan;">@args</span>);
<span style="color: brown;">28 </span> <span style="color: brown;"><b>return</b></span> <span style="color: brown;"><b>unless</b></span> <span style="color: darkcyan;">@result</span>;
<span style="color: brown;">29 </span> <span style="color: brown;"><b>return</b></span> <span style="color: brown;"><b>unless</b></span> <span style="color: darkcyan;">@result</span> > <span style="color: magenta;">1</span> <span style="color: brown;"><b>or</b></span> (<span style="color: brown;"><b>defined</b></span> <span style="color: darkcyan;">$result[</span><span style="color: magenta;">0</span><span style="color: darkcyan;">]</span> <span style="color: brown;"><b>and</b></span> <span style="color: darkcyan;">$result[</span><span style="color: magenta;">0</span><span style="color: darkcyan;">]</span> <span style="color: brown;"><b>ne</b></span> <span style="color: magenta;">""</span>);
<span style="color: brown;">30 </span> say YAML::Dump( <span style="color: darkcyan;">@result</span> == <span style="color: magenta;">1</span> ? <span style="color: darkcyan;">$result[</span><span style="color: magenta;">0</span><span style="color: darkcyan;">]</span> : <span style="color: darkcyan;">\@result</span> );
<span style="color: brown;">31 </span>}
<span style="color: brown;">32 </span>
<span style="color: brown;">33 </span><span style="color: brown;"><b>while</b></span> ( <span style="color: brown;"><b>defined</b></span>( <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: darkcyan;">$term</span><span style="color: darkcyan;">->readline</span>(<span style="color: magenta;">"</span><span style="color: magenta;">Listo> </span><span style="color: magenta;">"</span>) ) ) {
<span style="color: brown;">34 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>//</b></span>; <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: magenta;">$</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">35 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@args</span> = <span style="color: brown;"><b>split</b></span>( <span style="color: brown;"><b>/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>/</b></span>, <span style="color: darkcyan;">$command</span> ) <span style="color: brown;"><b>or</b></span> <span style="color: brown;"><b>next</b></span>;
<span style="color: brown;">36 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$oper</span> = looks_like_number( <span style="color: darkcyan;">$args[</span><span style="color: magenta;">0</span><span style="color: darkcyan;">]</span> ) ? <span style="color: magenta;">"</span><span style="color: magenta;">add_data</span><span style="color: magenta;">"</span> : <span style="color: brown;"><b>shift</b></span> <span style="color: darkcyan;">@args</span>;
<span style="color: brown;">37 </span> given (<span style="color: darkcyan;">$oper</span>) {
<span style="color: brown;">38 </span> when (<span style="color: darkcyan;">%FUNCS</span>) { apply( <span style="color: darkcyan;">$oper</span>, <span style="color: darkcyan;">@args</span> ) }
<span style="color: brown;">39 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">man</span><span style="color: magenta;">"</span>) { man <span style="color: magenta;">"</span><span style="color: magenta;">Statistics::Descriptive</span><span style="color: magenta;">"</span> }
<span style="color: brown;">40 </span> when ( [ <span style="color: magenta;">"</span><span style="color: magenta;">exit</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">quit</span><span style="color: magenta;">"</span> ] ) {<span style="color: brown;"><b>last</b></span>}
<span style="color: brown;">41 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">help</span><span style="color: magenta;">"</span>) {help}
<span style="color: brown;">42 </span> default { say <span style="color: magenta;">"</span><span style="color: magenta;">Error: tipee 'help' para ayuda</span><span style="color: magenta;">"</span> };
<span style="color: brown;">43 </span> }
<span style="color: brown;">44 </span>}
</pre>After this series of articles, I hope you can appreciate how fast you can work in Perl, using the mechanisms offered by the language and the vast amount of tools available on the CPAN.<br />
In future articles will use this example to illustrate other techniques such as web programming, object-oriented Perl and of course more modules from CPAN.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-47909993707802483662009-09-27T18:29:00.002-04:302009-09-27T20:49:28.210-04:30Statistic Calculator: User friendly cosole[<a href="http://perliscopio.blogspot.com/2009/09/calculadora-estadistica-consola.html">Original Spanish source</a>]<br />
One of the nice features for console applications is the ability to edit the command line and reusing previous commands, when these two characteristics meet the application is much friendlier. So let's add these features to the <a href="http://perliscope.blogspot.com/2009/09/statistic-calculator-using-system.html">calculator of the last article</a>.<br />
This is another job where CPAN shows why it is Perl' s best feature, I'll use <a href="http://search.cpan.org/perldoc?Term%3A%3AReadLine"><code>Term::ReadLine</code></a>, a unified interface for console reading, this library allows the use of several backends that implement it's functionality, and for our example to work I installed <code>Term::ReadLine::Perl</code>, but I suppose that <code>Term::ReadLine::Gnu</code> would work just as well. Both are interfaces of the GNU <a href="http://linux.die.net/man/3/readline">readline(3)</a> library used by many applications, including bash.<br />
To add a bash like interface to the calculator, we just need to change lines 27 and 28 by yhis:<br />
<pre><span style="color: brown;"></span><span style="color: brown;">28 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: darkcyan;">$term</span><span style="color: darkcyan;">->readline</span>(<span style="color: magenta;">"</span><span style="color: magenta;">Listo> </span><span style="color: magenta;">"</span>) <span style="color: brown;"><b>//</b></span> <span style="color: brown;"><b>last</b></span>;<span style="color: brown;"></span>
</pre>you must declare the use of the module, and initialize the terminal creating the $term object that will allow us to invoke the readline method:<br />
<pre><span style="color: brown;"> 7 </span><span style="color: #a020f0;">use </span>Term::ReadLine;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$term</span> = <span style="color: brown;"><b>new</b></span> Term::ReadLine <span style="color: magenta;">'</span><span style="color: magenta;">Statistic Calculator</span><span style="color: magenta;">'</span>;
</pre>I used <code>Term::ReadLine</code> and not any of the specific variants, because this one is responsible for selecting and loading a variant automatically, but also allows the user to have the control if necessary. The library has functions that allow you to decorate the prompt, autocompleting and some other goodies, CPAN again saves the day by just reading a module's documentation.<br />
I will fix some other annoying things that go through (read: bugs), first the most annoying but the easier to solve: an empty command gives an error message because an empty string is not matched by any when clause, to solve it, I just added:<br />
<pre>when (<span style="color: magenta;">"</span><span style="color: magenta;"></span><span style="color: magenta;">"</span>) { } # si el comando es vacío no hacer nada</pre>and it's ready.<br />
A harder problem are commands that return undef, such as "clear", and produces a warning thanks to the implicit use warnings by <a href="http://search.cpan.org/perldoc?Modern::Perl">Modern::Perl</a>:<br />
<pre>Listo> clear
Use of uninitialized value in concatenation (.) or string at calc1.pl line 32.
clear =
</pre><br />
To solve this problem I'm going to make a subroutine to apply functions and print results, so the dispatch cycle remains as clear a possible, so this:<br />
<pre><span style="color: brown;">32 </span> when (<span style="color: darkcyan;">%FUNCS</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span>-><span style="color: darkcyan;">$command</span> }</pre>will become this: <br />
<pre><span style="color: brown;">32 </span> when (<span style="color: darkcyan;">%FUNCS</span>) { apply <span style="color: magenta;"></span><span style="color: darkcyan;">$command</span><span style="color: magenta;"></span> }</pre>then we add the "apply" subroutine, that receives a command, executes it, and gets the result, but it returns without saying anything unless the result is defined and not an empty string (notice the remarkable similarity between last sentence the Perl one):<br />
<pre><span style="color: brown;">26 </span> <span style="color: brown;"><b>return</b></span> <span style="color: brown;"><b>unless</b></span> <span style="color: brown;"><b>defined</b></span> <span style="color: darkcyan;">$result</span> <span style="color: brown;"><b>and</b></span> <span style="color: darkcyan;">$result</span> <span style="color: brown;"><b>ne</b></span> <span style="color: magenta;">""</span>;
</pre>The calculator is now more user friendly, but still has some problems, if you try to execute "trimmed_mean", you'll notice lots of warnings, the manual ("man") describes the cause, "trimmed_mean" function receives parameters, but our program doesn't know how to handle this, so in next article I will fix this, and also make it display complex return values, such arrays and hashes.<br />
Now our full program looks like this:<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Scalar::Util <span style="color: magenta;">qw(</span><span style="color: magenta;"> looks_like_number </span><span style="color: magenta;">)</span>;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>Statistics::Descriptive;
<span style="color: brown;"> 6 </span><span style="color: #a020f0;">use </span>Pod::Perldoc;
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use </span>Term::ReadLine;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$term</span> = <span style="color: brown;"><b>new</b></span> Term::ReadLine <span style="color: magenta;">'</span><span style="color: magenta;">Statistic Calculator</span><span style="color: magenta;">'</span>;
<span style="color: brown;">10 </span>
<span style="color: brown;">11 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%FUNCS</span> = <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">1</span> } <span style="color: magenta;">qw(</span><span style="color: magenta;"> sum mean count variance standard_deviation</span>
<span style="color: brown;">12 </span><span style="color: magenta;"> min mindex max maxdex sample_range median harmonic_mean geometric_mean</span>
<span style="color: brown;">13 </span><span style="color: magenta;"> mode trimmed_mean clear </span><span style="color: magenta;">)</span>;
<span style="color: brown;">14 </span>
<span style="color: brown;">15 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@COMMANDS</span> = <span style="color: magenta;">qw(</span><span style="color: magenta;"> exit quit help man </span><span style="color: magenta;">)</span>;
<span style="color: brown;">16 </span>
<span style="color: brown;">17 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">help </span>{ say <span style="color: magenta;">"</span><span style="color: magenta;">Comandos: </span><span style="color: magenta;">"</span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">, </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>sort</b></span> <span style="color: darkcyan;">@COMMANDS</span>, <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%FUNCS</span> ) }
<span style="color: brown;">18 </span>
<span style="color: brown;">19 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">man </span>{ Pod::Perldoc-><span style="color: brown;"><b>new</b></span>(<span style="color: magenta;">args </span>=> <span style="color: darkcyan;">\@_</span>)->process }
<span style="color: brown;">20 </span>
<span style="color: brown;">21 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$s</span> = Statistics::Descriptive::Full-><span style="color: brown;"><b>new</b></span>();
<span style="color: brown;">22 </span>
<span style="color: brown;">23 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">apply </span>{
<span style="color: brown;">24 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: brown;"><b>shift</b></span>;
<span style="color: brown;">25 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$result</span> = <span style="color: darkcyan;">$s</span>-><span style="color: darkcyan;">$command</span>;
<span style="color: brown;">26 </span> <span style="color: brown;"><b>return</b></span> <span style="color: brown;"><b>unless</b></span> <span style="color: brown;"><b>defined</b></span> <span style="color: darkcyan;">$result</span> <span style="color: brown;"><b>and</b></span> <span style="color: darkcyan;">$result</span> <span style="color: brown;"><b>ne</b></span> <span style="color: magenta;">""</span>;
<span style="color: brown;">27 </span> say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: darkcyan;">$result</span><span style="color: magenta;">"</span>;
<span style="color: brown;">28 </span>}
<span style="color: brown;">29 </span>
<span style="color: brown;">30 </span><span style="color: brown;"><b>while</b></span> (<span style="color: brown;"><b>defined</b></span>(<span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: darkcyan;">$term</span><span style="color: darkcyan;">->readline</span>(<span style="color: magenta;">"</span><span style="color: magenta;">Listo> </span><span style="color: magenta;">"</span>))) {
<span style="color: brown;">31 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>//</b></span>; <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: magenta;">$</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">32 </span> given (<span style="color: darkcyan;">$command</span>) {
<span style="color: brown;">33 </span> when ( looks_like_number(<span style="color: darkcyan;">$_</span>) ) { <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->add_data</span>(<span style="color: darkcyan;">$command</span>) }
<span style="color: brown;">34 </span> when (<span style="color: darkcyan;">%FUNCS</span>) { apply <span style="color: darkcyan;">$command</span> }
<span style="color: brown;">35 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">man</span><span style="color: magenta;">"</span>) { man <span style="color: magenta;">"</span><span style="color: magenta;">Statistics::Descriptive</span><span style="color: magenta;">"</span> }
<span style="color: brown;">36 </span> when ( [ <span style="color: magenta;">"</span><span style="color: magenta;">exit</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">quit</span><span style="color: magenta;">"</span> ] ) { <span style="color: brown;"><b>last</b></span> }
<span style="color: brown;">37 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">help</span><span style="color: magenta;">"</span>) { help }
<span style="color: brown;">38 </span> when (<span style="color: magenta;">""</span>) { }
<span style="color: brown;">39 </span> default { say <span style="color: magenta;">"</span><span style="color: magenta;">Error: tipee 'help' para ayuda</span><span style="color: magenta;">"</span> }
<span style="color: brown;">40 </span> }
<span style="color: brown;">41 </span>}
</pre>Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-69149813110988195442009-09-23T11:10:00.003-04:302009-09-27T18:33:02.241-04:30Statistic Calculator: Using the system[<a href="http://perliscopio.blogspot.com/2009/09/calculadora-estadistica-usando-el.html">Original spanish source</a>]<br />
In the <a href="http://74.125.93.132/translate_c?hl=en&sl=es&tl=en&u=http://perliscopio.blogspot.com/2009/09/perl-inteligente.html&prev=hp&rurl=translate.google.com&usg=ALkJrhjjnWSoMI2Dks3BISfje2wd-6t6Og">last article</a> I told you we'll add a manual to our calculator, let's see some ways to interact with the Perl documentation system to achieve this.<br />
The command to look at calculator's documentation will be "man", and as I assume most people should have used <a href="http://perldoc.perl.org/perldoc.html">perldoc</a>, I shall start by using this command to display a manual.<br />
Perl has long has the ability to execute system commands in several ways, one of which is the "`" operator, if you write something like:<br />
<pre><span style="color: brown;">1 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@out</span> = <span style="color: brown;"><b>`</b></span><span style="color: magenta;">ls -l</span><span style="color: brown;"><b>`</b></span>
</pre>the array @out will end with each of the output lines of the command, you can also execute commands and use its output as input to a program using <a href="http://perldoc.perl.org/functions/open.html">open</a>:<br />
<pre><span style="color: brown;">1 </span><span style="color: brown;"><b>open</b></span> <span style="color: darkcyan;">$fd</span>, <span style="color: magenta;">"</span><span style="color: magenta;">-|</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">ls -ls</span><span style="color: magenta;">"</span> <span style="color: brown;"><b>or</b></span> <span style="color: brown;"><b>die</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">Error: </span><span style="color: darkcyan;">$!</span><span style="color: magenta;">"</span>
<span style="color: brown;">2 </span><span style="color: brown;"><b>while</b></span> ( <span style="color: brown;"><b>readline</b></span> <span style="color: darkcyan;">$fd</span> ) {
<span style="color: brown;">3 </span> <span style="color: blue;"># $_ contiene una línea de la salida del comando</span>
<span style="color: brown;">4 </span>}
</pre>which is surprising, though not highly recommended in these days, although I use it over and over at work, where I solve lots of things just doing little programs in Perl. <br />
But today I am interested in the "<a href="http://perldoc.perl.org/functions/system.html">system</a>" function that I will use as the first way to add a manual for our calculator. Since I don' t want to complicate the issue showing <a href="http://perldoc.perl.org/perlpod.html">how to write a manual</a>, I will use the Statistics::Descriptive's manual, the solution is to add a line to <a href="http://74.125.93.132/translate_c?hl=en&sl=es&tl=en&u=http://perliscopio.blogspot.com/2009/09/perl-inteligente.html&prev=hp&rurl=translate.google.com&usg=ALkJrhjjnWSoMI2Dks3BISfje2wd-6t6Og">last article</a>'s program:<br />
<pre><span style="color: brown;">21 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">man</span><span style="color: magenta;">"</span>) { <span style="color: brown;"><b>system</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">perldoc Statistics::Descriptive</span><span style="color: magenta;">"</span>) }
</pre>and that's it, such is Perl, there is nothing easier, some may say it is dirty, but it was definitively easy. When we use "<a href="http://perldoc.perl.org/functions/system.html">system</a>" perl sends the command directly to the shell, so is better to use it in this way:<br />
<pre><span style="color: brown;">21 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">man</span><span style="color: magenta;">"</span>) { <span style="color: brown;"><b>system</b></span>(<span style="color: magenta;">"</span><span style="color: magenta;">/usr/bin/perldoc", "Statistics::Descriptive</span><span style="color: magenta;">"</span>) }
</pre><a href="http://perldoc.perl.org/functions/system.html&prev=hp&rurl=translate.google.com&usg=ALkJrhh9_V2sw1LQaQ72v1qudsY1vRvZ_g"></a><a href="http://perldoc.perl.org/functions/system.html"></a>when <a href="http://perldoc.perl.org/functions/system.html">system</a> receives a list, perl executes the first element and pass the remaining ones as arguments, avoiding some security glitches that could occur, but the command isn't searched through the PATH, so you must pass the full path to the command executable. <br />
It is not a big surprise that the perldoc command is also written in Perl, so we probably can reuse the code for this program in our calculator. Looking into the program you will realize that perldoc is a very simple program, in fact, the two important lines are:<br />
<pre><span style="color: brown;">1 </span><span style="color: #a020f0;">use </span>Pod::Perldoc;
<span style="color: brown;">2 </span>Pod::Perldoc->run();
</pre>So all the perldoc's functionality is packed inside a Perl object!, this is a major pattern of Perl culture, allowing any application to be easily reused by another, and that is exactly what we want do, unfortunately someone forgot to document <code>Pod::Perldoc</code> so I got to look at the source code for hints about how may I integrate it into the calculator, I came up with the following:<br />
<pre><span style="color: brown;">21 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">man</span><span style="color: magenta;">"</span>) { Pod::Perldoc-><span style="color: brown;"><b>new</b></span>(<span style="color: magenta;">args </span>=> [<span style="color: magenta;">"</span><span style="color: magenta;">Statistics::Descriptive</span><span style="color: magenta;">"</span>])->process }
</pre>and of course we must declare the use of the class, which I did at the beginning of the program:<br />
<pre><span style="color: brown;"> 6 </span><span style="color: #a020f0;">use </span>Pod::Perldoc;
</pre>The real job was to learn how <code>Pod::Perldoc</code> works and it took me less than 2 minutes to get there using the excelent <a href="http://perldoc.perl.org/perldebug.html">perl debugger</a>.<br />
Finally I took some time to refactor the code a little bit, improve the "help" command, and left the full program like this:<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Scalar::Util <span style="color: magenta;">qw(</span><span style="color: magenta;"> looks_like_number </span><span style="color: magenta;">)</span>;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>Statistics::Descriptive;
<span style="color: brown;"> 6 </span><span style="color: #a020f0;">use </span>Pod::Perldoc;
<span style="color: brown;"> 7 </span>
<span style="color: brown;"> 8 </span><span style="color: #a020f0;">use constant</span> <span style="color: magenta;">SYNTAX_ERROR </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Error: tipee 'help' para ayuda</span><span style="color: magenta;">"</span>;
<span style="color: brown;"> 9 </span>
<span style="color: brown;">10 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%FUNCS</span> = <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">1</span> } <span style="color: magenta;">qw(</span><span style="color: magenta;"> sum mean count variance standard_deviation</span>
<span style="color: brown;">11 </span><span style="color: magenta;"> min mindex max maxdex sample_range median harmonic_mean geometric_mean</span>
<span style="color: brown;">12 </span><span style="color: magenta;"> mode trimmed_mean clear </span><span style="color: magenta;">)</span>;
<span style="color: brown;">13 </span>
<span style="color: brown;">14 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">@COMMANDS</span> = <span style="color: magenta;">qw(</span><span style="color: magenta;"> exit quit help man </span><span style="color: magenta;">)</span>;
<span style="color: brown;">15 </span>
<span style="color: brown;">16 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">help </span>{
<span style="color: brown;">17 </span> say <span style="color: magenta;">"</span><span style="color: magenta;">Comandos: </span><span style="color: magenta;">"</span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">, </span><span style="color: magenta;">"</span>, <span style="color: darkcyan;">@COMMANDS</span> );
<span style="color: brown;">18 </span> say <span style="color: magenta;">"</span><span style="color: magenta;">Funciones: </span><span style="color: magenta;">"</span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">, </span><span style="color: magenta;">"</span>, <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%FUNCS</span> );
<span style="color: brown;">19 </span>}
<span style="color: brown;">20 </span>
<span style="color: brown;">21 </span><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">man </span>{
<span style="color: brown;">22 </span> Pod::Perldoc-><span style="color: brown;"><b>new</b></span>(<span style="color: magenta;">args </span>=> <span style="color: darkcyan;">\@_</span>)->process
<span style="color: brown;">23 </span>}
<span style="color: brown;">24 </span>
<span style="color: brown;">25 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$s</span> = Statistics::Descriptive::Full-><span style="color: brown;"><b>new</b></span>();
<span style="color: brown;">26 </span><span style="color: brown;"><b>while</b></span> (<span style="color: magenta;">1</span>) {
<span style="color: brown;">27 </span> <span style="color: brown;"><b>print</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">Listo> </span><span style="color: magenta;">"</span>;
<span style="color: brown;">28 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: brown;"><b>readline</b></span>(<span style="color: darkcyan;">STDIN</span>) <span style="color: brown;"><b>//</b></span> <span style="color: brown;"><b>last</b></span>;
<span style="color: brown;">29 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>//</b></span>; <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: magenta;">$</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">30 </span> given (<span style="color: darkcyan;">$command</span>) {
<span style="color: brown;">31 </span> when ( looks_like_number(<span style="color: darkcyan;">$_</span>) ) { <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->add_data</span>(<span style="color: darkcyan;">$command</span>) }
<span style="color: brown;">32 </span> when (<span style="color: darkcyan;">%FUNCS</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span>-><span style="color: darkcyan;">$command</span> }
<span style="color: brown;">33 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">man</span><span style="color: magenta;">"</span>) { man<span style="color: magenta;"> "</span><span style="color: magenta;">Statistics::Descriptive</span><span style="color: magenta;">"</span> }
<span style="color: brown;">34 </span> when ( [ <span style="color: magenta;">"</span><span style="color: magenta;">exit</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">quit</span><span style="color: magenta;">"</span> ] ) {<span style="color: brown;"><b> last</b></span> }
<span style="color: brown;">35 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">help</span><span style="color: magenta;">"</span>) { help }
<span style="color: brown;">36 </span> default { say SYNTAX_ERROR }
<span style="color: brown;">37 </span> }
<span style="color: brown;">38 </span>}
</pre>In the <a href="http://perliscope.blogspot.com/2009/09/statistic-calculator-user-friendly.html">next article</a> I will add more features to make calculator more user friendly.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-49609670195054027622009-09-18T09:30:00.003-04:302009-09-23T11:13:55.976-04:30Smart Perl[<a href="http://perliscopio.blogspot.com/2009/09/perl-inteligente.html">Spanish original source</a>]<br />
In the <a href="http://perliscope.blogspot.com/2009/09/using-modern-perl.html">previous article</a> we saw an example of <a href="http://perliscope.blogspot.com/2009/09/using-modern-perl.html">modern Perl</a>, today we'll delve a bit more into Perl 5.10 smart matching, and how this combined with the dynamic nature of the language lead us to a ridiculously small program, which is also easier to understand and maintain. <br />
I once read (I think from <a href="http://www.paulgraham.com/articles.html">Paul Graham</a>) that when sections of code seems very similar, it usually means that a level of abstraction is required, of course he is a Lisp programmer, and has <a href="http://www.apl.jhu.edu/%7Ehall/Lisp-Notes/Macros.html">defmacro</a>. However Perl also has its own means, and in this case our first solution could be based on a hash that includes the functions allowed in our calculator:<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Scalar::Util <span style="color: magenta;">qw(</span><span style="color: magenta;"> looks_like_number </span><span style="color: magenta;">)</span>;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>Statistics::Descriptive;
<span style="color: brown;"> 6 </span>
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use constant</span> <span style="color: magenta;">SYNTAX_ERROR </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Error: tipee 'help' para ayuda</span><span style="color: magenta;">"</span>;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%FUNCS</span> = (
<span style="color: brown;">10 </span> <span style="color: magenta;">sum </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">11 </span> <span style="color: magenta;">mean </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">12 </span> <span style="color: magenta;">count </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">13 </span> <span style="color: magenta;">variance </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">14 </span> <span style="color: magenta;">standard_deviation </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">15 </span> <span style="color: magenta;">min </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">16 </span> <span style="color: magenta;">mindex </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">17 </span> <span style="color: magenta;">max </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">18 </span> <span style="color: magenta;">maxdex </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">19 </span> <span style="color: magenta;">sample_range </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">20 </span> <span style="color: magenta;">median </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">21 </span> <span style="color: magenta;">harmonic_mean </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">22 </span> <span style="color: magenta;">geometric_mean </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">23 </span> <span style="color: magenta;">mode </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">24 </span> <span style="color: magenta;">trimmed_mean </span>=> <span style="color: magenta;">0</span>,
<span style="color: brown;">25 </span>);
<span style="color: brown;">26 </span>
<span style="color: brown;">27 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$s</span> = Statistics::Descriptive::Full-><span style="color: brown;"><b>new</b></span>();
<span style="color: brown;">28 </span><span style="color: brown;"><b>while</b></span> (<span style="color: magenta;">1</span>) {
<span style="color: brown;">29 </span> <span style="color: brown;"><b>print</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">Listo> </span><span style="color: magenta;">"</span>;
<span style="color: brown;">30 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: brown;"><b>readline</b></span>(<span style="color: darkcyan;">STDIN</span>) <span style="color: brown;"><b>//</b></span> <span style="color: brown;"><b>last</b></span>;
<span style="color: brown;">31 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>//</b></span>; <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: magenta;">$</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">32 </span> given (<span style="color: darkcyan;">$command</span>) {
<span style="color: brown;">33 </span> when ( looks_like_number(<span style="color: darkcyan;">$_</span>) ) { <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->add_data</span>(<span style="color: darkcyan;">$command</span>) }
<span style="color: brown;">34 </span> when (<span style="color: brown;"><b>/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">(</span><span style="color: magenta;">exit|quit</span><span style="color: slateblue;">)</span><span style="color: magenta;">$</span><span style="color: brown;"><b>/</b></span>) {<span style="color: brown;"><b>last</b></span>}
<span style="color: brown;">35 </span> default {
<span style="color: brown;">36 </span> <span style="color: brown;"><b>if</b></span> ( <span style="color: brown;"><b>exists</b></span> <span style="color: darkcyan;">$FUNCS{$command}</span> ) { ... }
<span style="color: brown;">37 </span> <span style="color: brown;"><b>else</b></span> { say <span style="color: darkcyan;">SYNTAX_ERROR</span>}
<span style="color: brown;">38 </span> }
<span style="color: brown;">39 </span> }
<span style="color: brown;">40 </span>}
</pre><br />
This is a good step forward, because we are simplifying code in the complicated part of our program, and replacing it with a simple declaration of a hash, where including new functions is as simple as adding a line.<br />
Of course any astute reader already noticed that I cheated because the program is incomplete and line 36 requires an action, our problem is how do we invoke the right method for the operation, and as usual there is more than one way to do it, the worst could have the hash filled with references to the methods, like this:<br />
<br />
<pre><span style="color: brown;">10 </span> <span style="color: magenta;">sum </span>=> \&Statistics::Descriptive::sum,</pre><br />
which allows to invoke the methods as:<br />
<br />
<pre><span style="color: brown;">36 </span> <span style="color: brown;"><b>if</b></span> ( <span style="color: brown;"><b>exists</b></span> <span style="color: darkcyan;">$FUNCS{$command}</span> ) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$FUNCS{$command}(</span><span style="color: darkcyan;">$s)</span> }
</pre><br />
That is the worst way because you have to know a lot of Perl to understand how it works, and Perl has the ability to dispatch methods symbolically allow us to make our intention perfectly clear with code easier to understand:<br />
<pre><span style="color: brown;">36 </span> <span style="color: brown;"><b>if</b></span> ( <span style="color: brown;"><b>exists</b></span> <span style="color: darkcyan;">$FUNCS{$command}</span> ) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s->$command</span> }</pre><br />
The runtime cost involved in the later is higher than the former, but it is a price that I am willing to pay gladly, because it makes the program much easier to understand, and lately people is much more expensive than machines.<br />
Finally, if laziness is one of your principles, you can rewrite the definition of the hash like this:<br />
<pre><span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%FUNCS</span> = <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">0</span> } <span style="color: magenta;">qw(</span><span style="color: magenta;"> sum mean count variance standard_deviation</span>
<span style="color: brown;">10 </span><span style="color: magenta;"> min mindex max maxdex sample_range median harmonic_mean geometric_mean</span>
<span style="color: brown;">11 </span><span style="color: magenta;"> mode trimmed_mean </span><span style="color: magenta;">)</span>;
</pre>which I like, because it saves me some punctuation (which seems to overwhelm many people) and I have less probability of making a syntax error.<br />
Basically I'm building a list of words (the names of the methods) with "qw", from this list I build another (using <a href="http://perldoc.perl.org/functions/map.html">map</a>) that contains each element of the original list ($ _) followed by 0, perl automatically converts this list into a hash where each name is associated with 0 as its value.<br />
If you think the above explanation was complicated or incomprehensible, you can see the Perl documentation for <a href="http://perldoc.perl.org/functions/map.html">map</a>, what will be great because you can also learn something about <a href="http://www.defmacro.org/ramblings/fp.html">functional programming</a>, and that will be very helpful for sure.<br />
Now I'm going to get rid of the "if", I prefer multi-way conditionals because they are linear, they look better and are easier to follow, that's why I think that the given/when is the best thing that happened to Perl in a long time, besides I am also got rid of the regular expression in line 34 for something that makes more sense for a Perl outsider:<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Scalar::Util <span style="color: magenta;">qw(</span><span style="color: magenta;"> looks_like_number </span><span style="color: magenta;">)</span>;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>Statistics::Descriptive;
<span style="color: brown;"> 6 </span>
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use constant</span> <span style="color: magenta;">SYNTAX_ERROR </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Error: tipee 'help' para ayuda</span><span style="color: magenta;">"</span>;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%FUNCS</span> = <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">1</span> } <span style="color: magenta;">qw(</span><span style="color: magenta;"> sum mean count variance standard_deviation</span>
<span style="color: brown;">10 </span><span style="color: magenta;"> min mindex max maxdex sample_range median harmonic_mean geometric_mean</span>
<span style="color: brown;">11 </span><span style="color: magenta;"> mode trimmed_mean </span><span style="color: magenta;">)</span>;
<span style="color: brown;">12 </span>
<span style="color: brown;">13 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$s</span> = Statistics::Descriptive::Full-><span style="color: brown;"><b>new</b></span>();
<span style="color: brown;">14 </span><span style="color: brown;"><b>while</b></span> (<span style="color: magenta;">1</span>) {
<span style="color: brown;">15 </span> <span style="color: brown;"><b>print</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">Listo> </span><span style="color: magenta;">"</span>;
<span style="color: brown;">16 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: brown;"><b>readline</b></span>(<span style="color: darkcyan;">STDIN</span>) <span style="color: brown;"><b>//</b></span> <span style="color: brown;"><b>last</b></span>;
<span style="color: brown;">17 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>//</b></span>; <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: magenta;">$</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">18 </span> given (<span style="color: darkcyan;">$command</span>) {
<span style="color: brown;">19 </span> when ( looks_like_number(<span style="color: darkcyan;">$_</span>) ) { <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->add_data</span>(<span style="color: darkcyan;">$command</span>) }
<span style="color: brown;">20 </span> when ( [<span style="color: magenta;">"</span><span style="color: magenta;">exit</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">quit</span><span style="color: magenta;">"</span>] ) {<span style="color: brown;"><b>last</b></span>}
<span style="color: brown;">21 </span> when (<span style="color: darkcyan;">%FUNCS</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span>-><span style="color: darkcyan;">$command</span> }
<span style="color: brown;">22 </span> default { say SYNTAX_ERROR }
<span style="color: brown;">23 </span> }
<span style="color: brown;">24 </span>}
</pre>Now it looks a lot better (it even resembles <a href="http://radarlibre.blogspot.com/search?q=Erlang">Erlang</a>).<br />
I am using some functions of the smart matching that will explain below.<br />
In line 20 there is an array matching:<br />
<pre><span style="color: darkcyan;">$command ~~ </span>[<span style="color: magenta;">"</span><span style="color: magenta;">exit</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">quit</span><span style="color: magenta;">"</span>]</pre>Matching a scalar (to left) against an array (to the right) is equivalent to:<br />
<pre><span style="color: brown;"><b>sub</b></span><span style="color: darkcyan;"> </span><span style="color: darkcyan;">match_scalar_arrayref </span>{
<span style="color: brown;"><b>my</b></span> (<span style="color: darkcyan;">$scalar</span>, <span style="color: darkcyan;">$arrayref</span>) = <span style="color: darkcyan;">@_</span>;
<span style="color: brown;"><b>for</b></span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$item</span> ( <span style="color: darkcyan;">@$arrayref</span> ) {
<span style="color: brown;"><b>return</b></span> <span style="color: magenta;">1</span> <span style="color: brown;"><b>if</b></span> <span style="color: darkcyan;">$scalar</span> <span style="color: brown;"><b>eq</b></span> <span style="color: darkcyan;">$item</span>;
}
<span style="color: brown;"><b>return</b></span> <span style="color: brown;"><b>undef</b></span>;
}
</pre>I can't remember how many times I've wrote code like that, or this:<br />
<pre><span style="color: brown;"><b>if</b></span> ( <span style="color: brown;"><b>grep</b></span> { <span style="color: darkcyan;">$scalar</span> <span style="color: brown;"><b>eq</b></span> <span style="color: darkcyan;">$_</span> } <span style="color: darkcyan;">@$arrayref</span> ) ...
</pre>which I may be able to write clearly and with less work:<br />
<pre><span style="color: brown;"><b>if</b></span> ( <span style="color: darkcyan;">$scalar</span> ~~ <span style="color: darkcyan;">$arrayref</span> ) ...
</pre>Probably you've already guessed that match at line 21 is equivalent to:<br />
<pre><span style="color: brown;"><b></b></span><span style="color: brown;"><b>if</b></span> ( <span style="color: brown;"><b>exists</b></span> <span style="color: darkcyan;">$hash{$scalar}</span> ) ...
</pre><h2>A little temptation</h2>I received a reader's suggestion that make our program shorter and easier to maintain, the idea was to change the line:<br />
<br />
<pre><span style="color: brown;">21 </span> when (<span style="color: darkcyan;">%FUNCS</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span>-><span style="color: darkcyan;">$command</span> }</pre><br />
by:<br />
<pre><span style="color: brown;">21 </span> when (<span style="color: darkcyan;">$s->can($command)</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span>-><span style="color: darkcyan;">$command</span> }</pre><br />
The "can" method is provided by the UNIVERSAL class, from which all objects ultimate derive in Perl, and the purpose of this method is to determine if an object or class has a particular method.<br />
By using this we could delete %FUNCS completly, our interpreter will be automatically updated with new commands as Statistics:: Descriptive evolves, which sounds very good from the standpoint of maintainability, however, this has a fatal flaw for me: is not safe.<br />
The problem is that I lose control over what Perl runs automatically, which may not be critical in this case, but it could be extremely dangerous. So I prefer the security and keep the hash as a mechanism of dispatch (and authorization of use).<br />
The moral is to be careful when using dynamic execution control mechanisms, especially when using data from external unreliable sources to be injected into this execution control mechanisms.<br />
<h2>Finishing the program<br />
</h2><br />
<br />
Line 22 gives an error when a command is unknown, the message says to use "help" for help, but the command "help" is not implemented yet, a quick way to implement it is:<br />
<pre><span style="color: brown;">23 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">help</span><span style="color: magenta;">"</span>) {
<span style="color: brown;">24 </span> say <span style="color: magenta;">"</span><span style="color: magenta;">Los comandos válidos son: </span><span style="color: magenta;">"</span>
<span style="color: brown;">25 </span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">, </span><span style="color: magenta;">"</span>, <span style="color: magenta;">qw(</span><span style="color: magenta;">exit quit help</span><span style="color: magenta;">)</span>, <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%FUNCS</span> )
<span style="color: brown;">26 </span> }</pre>Wow, that was easy, and the best is that it is also consistent because it uses the same data structure to report, select and authorize the commands.<br />
One command that I forgot to include in the calculator in the previous article was "clear", adding this function now is as simple as putting a new word in the definition of %FUNCS:<br />
<pre><span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%FUNCS</span> = <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">1</span> } <span style="color: magenta;">qw(</span><span style="color: magenta;"> sum mean count variance standard_deviation</span>
<span style="color: brown;">10 </span><span style="color: magenta;"> min mindex max maxdex sample_range median harmonic_mean geometric_mean</span>
<span style="color: brown;">11 </span><span style="color: magenta;"> mode trimmed_mean clear </span><span style="color: magenta;">)</span>; </pre>It was easy, right?. The best thing is that the new command appears automatically in the help because the program is consistent.<br />
Lets recap today's accomplishments, we have a program:<br />
<ul><li>Very compact<br />
</li>
<li>Easy to understand<br />
</li>
<li>Easy to mantain<br />
</li>
<li>Consistent</li>
<li>Safe<br />
</li>
</ul><br />
Perl is as good or as any other language at many fronts including good design a quality, but few languages offer mechanisms like the ones used here to develop this program with such little work.<br />
<a href="http://perliscope.blogspot.com/2009/09/statistic-calculator-using-system.html">Next time</a> I will improve the example with a manual of statistic functions with very little effort.<br />
I will say goodbye with the final version of the program.<br />
<pre><span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Scalar::Util <span style="color: magenta;">qw(</span><span style="color: magenta;"> looks_like_number </span><span style="color: magenta;">)</span>;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>Statistics::Descriptive;
<span style="color: brown;"> 6 </span>
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use constant</span> <span style="color: magenta;">SYNTAX_ERROR </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Error: tipee 'help' para ayuda</span><span style="color: magenta;">"</span>;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">%FUNCS</span> = <span style="color: brown;"><b>map</b></span> { <span style="color: darkcyan;">$_</span> => <span style="color: magenta;">1</span> } <span style="color: magenta;">qw(</span><span style="color: magenta;"> sum mean count variance standard_deviation</span>
<span style="color: brown;">10 </span><span style="color: magenta;"> min mindex max maxdex sample_range median harmonic_mean geometric_mean</span>
<span style="color: brown;">11 </span><span style="color: magenta;"> mode trimmed_mean clear </span><span style="color: magenta;">)</span>;
<span style="color: brown;">12 </span>
<span style="color: brown;">13 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$s</span> = Statistics::Descriptive::Full-><span style="color: brown;"><b>new</b></span>();
<span style="color: brown;">14 </span><span style="color: brown;"><b>while</b></span> (<span style="color: magenta;">1</span>) {
<span style="color: brown;">15 </span> <span style="color: brown;"><b>print</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">Listo> </span><span style="color: magenta;">"</span>;
<span style="color: brown;">16 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: brown;"><b>readline</b></span>(<span style="color: darkcyan;">STDIN</span>) <span style="color: brown;"><b>//</b></span> <span style="color: brown;"><b>last</b></span>;
<span style="color: brown;">17 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">18 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: magenta;">$</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">19 </span> given (<span style="color: darkcyan;">$command</span>) {
<span style="color: brown;">20 </span> when ( looks_like_number(<span style="color: darkcyan;">$_</span>) ) { <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->add_data</span>(<span style="color: darkcyan;">$command</span>) }
<span style="color: brown;">21 </span> when (<span style="color: darkcyan;">%FUNCS</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span>-><span style="color: darkcyan;">$command</span> }
<span style="color: brown;">22 </span> when ( [ <span style="color: magenta;">"</span><span style="color: magenta;">exit</span><span style="color: magenta;">"</span>, <span style="color: magenta;">"</span><span style="color: magenta;">quit</span><span style="color: magenta;">"</span> ] ) {<span style="color: brown;"><b>last</b></span>}
<span style="color: brown;">23 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">help</span><span style="color: magenta;">"</span>) {
<span style="color: brown;">24 </span> say <span style="color: magenta;">"</span><span style="color: magenta;">Los comandos válidos son: </span><span style="color: magenta;">"</span>
<span style="color: brown;">25 </span> . <span style="color: brown;"><b>join</b></span>( <span style="color: magenta;">"</span><span style="color: magenta;">, </span><span style="color: magenta;">"</span>, <span style="color: magenta;">qw(</span><span style="color: magenta;">exit quit help</span><span style="color: magenta;">)</span>, <span style="color: brown;"><b>keys</b></span> <span style="color: darkcyan;">%FUNCS</span> )
<span style="color: brown;">26 </span> }
<span style="color: brown;">27 </span> default { say SYNTAX_ERROR };
<span style="color: brown;">28 </span> }
<span style="color: brown;">29 </span>}
</pre>Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com2tag:blogger.com,1999:blog-699609172043710797.post-21412852939807016222009-09-15T15:45:00.005-04:302009-09-18T09:38:23.322-04:30Using Modern Perl[<a href="http://perliscopio.blogspot.com/2009/09/usando-perl-moderno.html">Source article in spanish</a>]<br />
I will try to write a series of articles about Perl, showing how easy and quick is to make solutions based on this platform.<br />
For this I chose a simple design that allows me to illustrate a number of techniques and best practices, with an algorithm accessible to any developer even to a rookie.<br />
The example program will be a statistical calculator which at first will be written in a traditional style, but will gradually become more flexible and easier to maintain, while applying some unique mechanisms of language and some libraries from <a href="http://www.cpan.org/">CPAN</a>.<br />
The grand finale is to make the calculator as a web application using a suprising mechanism available for Perl. Having said that, I will start using modern Perl now.<br />
Giving honor to the title of the article, the first thing our program does is to use the module <a href="http://search.cpan.org/perldoc?Modern%3A%3APerl">Modern::Perl</a>, which is a shortcut to say:<br />
<pre><code>
use feature ':5.10';
use strict;
use warnings;
use mro 'c3';
</code></pre>That is, turns on all the features introduced in Perl 5.10, also activates the strict and warnings, and finally set the <a href="http://search.cpan.org/perldoc?mro">method resolution order</a> to the C3 algorithm. As expected all the examples we will see throughout this series of articles, will only work in Perl 5.10, because I'm trying to promote as many new features as possible, so: <a href="http://www.perl.org/get.html">install Perl 5.10 now</a>.<br />
Modern Perl advocates strongly recommended the use of strict because it captures many common errors, including accidental use of symbolic references, and typographical errors in variable names, at the cost of declaring them with our (globals) or my (lexicals) before use.<br />
Perl warnings inform us about possible errors in coding. In Perl 5.10 strict is more strict and warnings gives many new warnings, so, they catch more problems than before, which usually improves the overall quality of code and save debugging time.<br />
In my case, when I wanted to read a command or finish the cycle in case of an end of file, so I wrote:<br />
<pre><code>
my $comando = readline(STDIN) or last;
</code></pre>Perl immediately warned me that in some cases undef (which signals the EOF) could be confused with "0" (zero) coming from the file, because perl interprets "0" and undef as false values. One way to correct the instruction would be:<br />
<pre><code>
defined (my $comando = readline(STDIN)) or last;
</code></pre>But I rather use the new operator // (defined or), that simplifies the statement:<br />
<pre><code>
my $comando = readline(STDIN) // last;
</code></pre>The C3 method resolution order, solves some problems with the original resolution order of Perl, and it is advisable to always use it in new code, this is not entirely new, there are modules that use this resolution order for some 4 years now, beacause of a CPAN module (<a href="http://search.cpan.org/perldoc?Class%3A%3AC3">Class:: C3</a>) but now C3 has native support in the language.<br />
So the first tip is to use Modern:: Perl everywhere, because it activates a number of useful and recommended features of Perl in one shot.<br />
Returning to the program, after using Modern:: Perl, it imports the subroutine looks_like_number() of <a href="http://search.cpan.org/perldoc?Scalar%3A%3AUtil">Scalar:: Util</a>, which saved me the trouble of writing regular expressions to recognize numbers, and also saves a lot of panic from readers that can freeze just by looking at <a href="http://perldoc.perl.org/perlfaq4.html#How-do-I-determine-whether-a-scalar-is-a-number/whole/integer/float?">those regular expressions</a>.<br />
The last module in use is the main ingredient of the calculator, it never crossed my mind to write statistical algorithms, that's the pupose of CPAN, which has almost everything in it. I choose to use <a href="http://search.cpan.org/perldoc?Statistics%3A%3ADescriptive">Statistics:: Descriptive</a>, which serves my purpose perfectly.<br />
Line 7 declares a <a href="http://search.cpan.org/perldoc?constant">constant</a> with an error message and line 9 defines a variable with an <a href="http://search.cpan.org/perldoc?perltoot">object</a> of class Statistics::Descriptive::Full which will be the state of the calculator during the main loop.<br />
The main loop is simple: read a command or terminate (last) if reached end of file [line 12], then remove the spaces from the left and right of the command [line 13], if the command is a number add it to the dataset [line 15] and if not, select and execute a command.<br />
The selection is done with the new control structure of Perl 5.10 <a href="http://perldoc.perl.org/perlsyn.html#Switch-statements">given/when</a> [lines 18-36] that performs <a href="http://perldoc.perl.org/perlsyn.html#Smart-matching-in-detail">smart matching</a> between the given value and the when clauses. As the matching is "smart" depends on the operands, and generally works as expected, however there are some oddities and it never hurts to <a href="http://perldoc.perl.org/perlsyn.html#Switch-statements">read the manual</a>.<br />
Finally, the new say operator is just a print which puts a newline at the end of the string, avoiding a lot of concatenations with "\n" and therefore contributing to code clarity.<br />
<pre><code>
<span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Scalar::Util <span style="color: magenta;">qw(</span><span style="color: magenta;"> looks_like_number </span><span style="color: magenta;">)</span>;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>Statistics::Descriptive;
<span style="color: brown;"> 6 </span>
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use constant</span> <span style="color: magenta;">SYNTAX_ERROR </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Error: tipee 'help' para ayuda</span><span style="color: magenta;">"</span>;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$s</span> = Statistics::Descriptive::Full-><span style="color: brown;"><b>new</b></span>();
<span style="color: brown;">10 </span><span style="color: brown;"><b>while</b></span> (<span style="color: magenta;">1</span>) {
<span style="color: brown;">11 </span> <span style="color: brown;"><b>print</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">Listo> </span><span style="color: magenta;">"</span>;
<span style="color: brown;">12 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: brown;"><b>readline</b></span>(<span style="color: darkcyan;">STDIN</span>) <span style="color: brown;"><b>//</b></span> <span style="color: brown;"><b>last</b></span>;
<span style="color: brown;">13 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>//</b></span>; <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: magenta;">$</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">14 </span> <span style="color: brown;"><b>if</b></span> ( looks_like_number(<span style="color: darkcyan;">$command</span>) ) {
<span style="color: brown;">15 </span> <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->add_data</span>(<span style="color: darkcyan;">$command</span>);
<span style="color: brown;">16 </span> }
<span style="color: brown;">17 </span> <span style="color: brown;"><b>else</b></span> {
<span style="color: brown;">18 </span> given (<span style="color: darkcyan;">$command</span>) {
<span style="color: brown;">19 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">sum</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->sum</span>() }
<span style="color: brown;">20 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">mean</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->mean</span>() }
<span style="color: brown;">21 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">count</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->count</span>() }
<span style="color: brown;">22 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">variance</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->variance</span>() }
<span style="color: brown;">23 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">standard_deviation</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->standard_deviation</span>() }
<span style="color: brown;">24 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">min</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->min</span>() }
<span style="color: brown;">25 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">mindex</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->mindex</span>() }
<span style="color: brown;">26 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">max</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->max</span>() }
<span style="color: brown;">27 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">maxdex</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->maxdex</span>() }
<span style="color: brown;">28 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">sample_range</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->sample_range</span>() }
<span style="color: brown;">29 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">median</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->median</span>() }
<span style="color: brown;">30 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">harmonic_mean</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->harmonic_mean</span>() }
<span style="color: brown;">31 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">geometric_mean</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->geometric_mean</span>() }
<span style="color: brown;">32 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">mode</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->mode</span>() }
<span style="color: brown;">33 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">trimmed_mean</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->trimmed_mean</span>() }
<span style="color: brown;">34 </span> when (<span style="color: brown;"><b>/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">(</span><span style="color: magenta;">exit|quit</span><span style="color: slateblue;">)</span><span style="color: magenta;">$</span><span style="color: brown;"><b>/</b></span>) {<span style="color: brown;"><b>last</b></span>}
<span style="color: brown;">35 </span> default { say SYNTAX_ERROR }
<span style="color: brown;">36 </span> }
<span style="color: brown;">37 </span> }
<span style="color: brown;">38 </span>}
</code></pre>To use the calculator simply execute the file, below is a test run:<br />
<pre><code>
opr@toshi$ perl stat.pl</code></pre><pre><code>Listo> 19
Listo> 45
Listo> 24
Listo> 15
Listo> 39
Listo> 48
Listo> 36
Listo> count
count = 7
Listo> 10
Listo> 28
Listo> 30
Listo> count
count = 10
Listo> mean
mean = 29.4
Listo> standard_deviation
standard_deviation = 12.685950233756
Listo> salir
Error: tipee 'help' para ayuda
Listo> help
Error: tipee 'help' para ayuda
Listo> exit
opr@toshi$
</code></pre><h2>A simple improvement</h2>A better way to write the program would be to delete the if statement at line 15 and make a new "when" clause, this also allows me to show that given topicalizes $_ to the given value and when clauses not only compare strings (using eq) and regular expressions (using =~) but also allow, <a href="http://perldoc.perl.org/perlsyn.html#Switch-statements">among others</a>, to write boolean expressions using $_ as an alias to the value being matched.<br />
<pre><code>
<span style="color: brown;"> 1 </span><span style="color: #a020f0;">#!/usr/bin/perl</span>
<span style="color: brown;"> 2 </span>
<span style="color: brown;"> 3 </span><span style="color: #a020f0;">use </span>Modern::Perl;
<span style="color: brown;"> 4 </span><span style="color: #a020f0;">use </span>Scalar::Util <span style="color: magenta;">qw(</span><span style="color: magenta;"> looks_like_number </span><span style="color: magenta;">)</span>;
<span style="color: brown;"> 5 </span><span style="color: #a020f0;">use </span>Statistics::Descriptive;
<span style="color: brown;"> 6 </span>
<span style="color: brown;"> 7 </span><span style="color: #a020f0;">use constant</span> <span style="color: magenta;">SYNTAX_ERROR </span>=> <span style="color: magenta;">"</span><span style="color: magenta;">Error: tipee 'help' para ayuda</span><span style="color: magenta;">"</span>;
<span style="color: brown;"> 8 </span>
<span style="color: brown;"> 9 </span><span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$s</span> = Statistics::Descriptive::Full-><span style="color: brown;"><b>new</b></span>();
<span style="color: brown;">10 </span><span style="color: brown;"><b>while</b></span> (<span style="color: magenta;">1</span>) {
<span style="color: brown;">11 </span> <span style="color: brown;"><b>print</b></span> <span style="color: magenta;">"</span><span style="color: magenta;">Listo> </span><span style="color: magenta;">"</span>;
<span style="color: brown;">12 </span> <span style="color: brown;"><b>my</b></span> <span style="color: darkcyan;">$command</span> = <span style="color: brown;"><b>readline</b></span>(<span style="color: darkcyan;">STDIN</span>) <span style="color: brown;"><b>//</b></span> <span style="color: brown;"><b>last</b></span>;
<span style="color: brown;">13 </span> <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: brown;"><b>//</b></span>; <span style="color: darkcyan;">$command</span> =~ <span style="color: brown;"><b>s/</b></span><span style="color: slateblue;">\s</span><span style="color: slateblue;">+</span><span style="color: magenta;">$</span><span style="color: brown;"><b>//</b></span>;
<span style="color: brown;">14 </span> given (<span style="color: darkcyan;">$command</span>) {
<span style="color: brown;">15 </span> when ( looks_like_number(<span style="color: darkcyan;">$_</span>) ) { <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->add_data</span>(<span style="color: darkcyan;">$command</span>) }
<span style="color: brown;">16 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">sum</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->sum</span>() }
<span style="color: brown;">17 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">mean</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->mean</span>() }
<span style="color: brown;">18 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">count</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->count</span>() }
<span style="color: brown;">19 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">variance</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->variance</span>() }
<span style="color: brown;">20 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">standard_deviation</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->standard_deviation</span>() }
<span style="color: brown;">21 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">min</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->min</span>() }
<span style="color: brown;">22 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">mindex</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->mindex</span>() }
<span style="color: brown;">23 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">max</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->max</span>() }
<span style="color: brown;">24 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">maxdex</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->maxdex</span>() }
<span style="color: brown;">25 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">sample_range</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->sample_range</span>() }
<span style="color: brown;">26 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">median</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->median</span>() }
<span style="color: brown;">27 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">harmonic_mean</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->harmonic_mean</span>() }
<span style="color: brown;">28 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">geometric_mean</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->geometric_mean</span>() }
<span style="color: brown;">29 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">mode</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->mode</span>() }
<span style="color: brown;">30 </span> when (<span style="color: magenta;">"</span><span style="color: magenta;">trimmed_mean</span><span style="color: magenta;">"</span>) { say <span style="color: magenta;">"</span><span style="color: darkcyan;">$command</span><span style="color: magenta;"> = </span><span style="color: magenta;">"</span> . <span style="color: darkcyan;">$s</span><span style="color: darkcyan;">->trimmed_mean</span>() }
<span style="color: brown;">31 </span> when (<span style="color: brown;"><b>/</b></span><span style="color: magenta;">^</span><span style="color: slateblue;">(</span><span style="color: magenta;">exit|quit</span><span style="color: slateblue;">)</span><span style="color: magenta;">$</span><span style="color: brown;"><b>/</b></span>) {<span style="color: brown;"><b>last</b></span>}
<span style="color: brown;">32 </span> default { say SYNTAX_ERROR }
<span style="color: brown;">33 </span> }
<span style="color: brown;">34 </span>}
</code></pre>I think that almost any programmer used to dynamic languages like Python or Ruby can readily understand code in Modern Perl and even be comfortable working with it.<br />
The programmers of languages like C, C++, C# or Java, after getting used to some basic principles should feel a kind of liberating experience, because writing a program such this in those languages is certanly more difficult.<br />
In the <a href="http://perliscope.blogspot.com/2009/09/smart-perl.html">next article</a> we'll see some dynamic features of Perl that make the program shorter, more flexible and easier to maintain.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com0tag:blogger.com,1999:blog-699609172043710797.post-13222560488487262702009-08-24T23:07:00.003-04:302009-09-18T09:41:45.237-04:30Archaic PerlA couple of days ago I had to attend a vendor who came to offer their services for the development of a web application.<br />
As one of the participants of the organization had to handle some unexpected event, I took the opportunity to start a small research during casual conversation: "What development tools do you use at company?". In an ideal world the answer would have been: "Perl", but they told me that they work mainly in Python, but can work in other environments, including Perl. After informing them that the organization prefer Perl for the development of our applications, and after a micro religious debate, one of them (Juan) concluded:<br />
<blockquote>In the end anything that can be done in one language that can be done in the other, but Perl programming is just more archaic.<br />
</blockquote>that nearly upset me, but given that the missing guy arrived and the important issue was the meeting, I remained calm.<br />
Now in retrospect I wonder: what he meant by saying that Perl is archaic? Perhaps John was referring to Perl 1 (1987), which was a kind of Shell Script with grep, sed and awk included, he could even think that until Perl 4 (1991, soon after Python 1.0), however the current age is Perl 5 (1994) and viewing the subject young age, I think that Juan couldn't find a word to describe the <i><b>mythical</b></i> defects of Perl, so he ended up using the wrong word.<br />
If Perl is archaic, then probably the object-oriented and functional programming are too, however those are the two technologies with most momentum at the present, and given that <a href="http://www.perl.com/pub/a/2007/12/06/soto-11.html">Perl's own object system was copied from Python</a>, I will assume he meant some of the following:<br />
<ol><li>Perl is ugly</li>
<li>Perl is messy</li>
<li>Perl is unreadable</li>
<li>Perl is incomprehensible</li>
</ol>I will briefly address these prejudices that have been widely circulated on the Internet and for which there is no real support, much less after the rebirth of Perl (which I will discuss in another article).<br />
<h2>Perl is ugly</h2>As this is a matter of taste, things which are ugly to some one may be very attractive to other. But assuming that Perl is one of the ugliest languages, it has features that make it a practial language to solve a lot of problems easily.<br />
One of the features that make Perl syntax leaning (not necessarily ugly) are the sigils indicating the type of each variable, however this feature facilitates extensibility and allows the interpolation in strings, and when I say Perl is extensible I mean that we can intervene in the compilation process to change its original syntax, a very high level feature shared with few languages, and the basis of the <a href="http://en.wikipedia.org/wiki/Domain-specific_programming_language">domain specific languages</a> (also called DSL) that are very useful and popular. Perl offers at least three different mechanisms to achieve this goal.<br />
Another feature is the practical integration of regular expressions within the language, therefore making extensive use of them, unfortunately, these expressions are ugly no matter what language are you using.<br />
Take for example the parsing of a specific instruction from LaTeX:<br />
<code><br />
\begin{document}<br />
</code><br />
In Perl it would look something like:<br />
<code><br />
if ( $latex =~ m/\\begin\{[az]+\}/ ) ...<br />
</code><br />
In Python it would look like:<br />
<code><br />
pattent = re.compile(r'\\begin\{[az]+\}')<br />
if pattern.match(latex):<br />
...<br />
</code><br />
In fact neither is nice, but Perl is really more succinct and easier to understand, and I will not show the hassle to use them from Java.<br />
Finally there is the holy argument about coding style and all that nonsense about the compiler enforcing to write the code in a good style. I say this because even when I think you get used to "the right coding style", it is also true that sometimes this is a nuisance and gets in your way, and in such cases there is no remedy. Below there is an example of Python code hard to format because of inflexible language syntax.<br />
When code requires a particular style, you should use formatting tools, for example I use <code>indent</code> for C, and <code>perltidy</code> for Perl, lately I write my Perl code in the following style:<br />
<code><br />
perltidy -l=99 -sbl<br />
</code><br />
No matter how I get code delivered or if I type it myself, because I can convert it into my standard style with a single command, even before saving it (I use vim).<br />
<h2>Perl is messy</h2>Languages are not messy, people are.<br />
However, there are languages that have more features than others to organize a project, Perl provides several ways to organize the code to suit many needs, ranging from programming on a single line (command) to the construction of large and complex applications.<br />
The language allows the creation of procedural modules with their own namespaces, which may even be organized into multiple files to be loaded "on demand", very enterprise, isn't it?.<br />
While most languages only have a fixed way of handling objects, Perl has a basic object system that allows to implement OOP in many ways, like the language motto says: "there is more than one way to do it".<br />
Perl avoids to force the programmer to follow a particular structure, whether it fits the needs of a specific program or not, otherwise it would be like Java.<br />
<h2>Perl is unreadable</h2>This is just a particular combination of the two myths that preceded it, but it is also argued that you can not read the code wrote after 15 min., and that may be good some times, because it allows you to write programs quickly even if they are dirty, after all nobody wants to design and document code following the principles of software engineering to understand the last program I wrote a few hours ago, only because I needed a hint on the character frequencies in a dozen files:<br />
<code><br />
perl -MYAML -ne '$c{$_}++for split//;END{print Dump\%c}' data.txt<br />
</code><br />
It is easier to write this again than trying to understand it, of course this is easy to make in Perl because it has some magical constructs, do not try something like this in another language, because your best scenario is to make it work, but I guarantee that it will be much longer and difficult.<br />
But Perl also allows you to write nicer code if it were necessary:<br />
<pre><code>
use YAML;
use IO::File;
use strict;
my %counts;
my $fd = new IO::File $ARGV[0], "r";
while ( my $line = readline($fd) ) {
for my $letter ( split( //, $line ) ) {
$counts{$letter}++;
}
}
print YAML::Dump( \%counts )
</code></pre>I'm sure this is as easy to understand as Python or Ruby for a programmer, isn't it?. Then the issue is not if the Perl language is unreadable, but the motivation to write the program, and the programmers expertice to write code easily readable or maintainable even by less experienced colleagues.<br />
Finally, the least of my worries while making the last example was formating the code, since my editor did most of that work automatically, but just in case, I used <code>perltidy</code> on it, for you to see how well it looks.<br />
<h2>Perl is incomprehensible</h2>For whom?, Japanese is incomprehensible to me, but I doubt that to be the case for most people living in Tokyo, Perl is equally incomprehensible to someone who is not trained to understand it. In the previous section I showed you that Perl code may be as clear as Java or Python counterparts.<br />
Certainly there is a lot of Perl code that is <a href="http://perl.plover.com/obfuscated/">virtually incomprehensible</a> except for the language gurus, but that doesn't mean that the programs should be written that way.<br />
The shorthand form that allows to obfuscate Perl code also makes perl not just an interpreter, but a very useful tool in the command line, also allowing the expression of the <a href="http://www.ibm.com/developerworks/linux/library/l-japh.html">genious and expertise</a> over the language. There are very few languages that allow yo do <a href="http://www.cpan.org/misc/japh">JAPHs</a> as Perl.<br />
The fallacy appears when people start saying things like: "Perl is evil because it allows those things", or my favorite: "It is impossible to write unreadable programs in Python", really?, lets see who understands this little program written in Python:<br />
<pre><code>
for n in range(12):
exec("abcdefghijkl"[n]+"=lambda x=0,y=0: "+filter(
lambda x:x not in "\n$\r","""(x*y#x/x!range(x,
y#x+y!b(1,1#d(e~,e~#d(f~,f~#c(e~,e~+d(g~,d(g~,g~))#"%4
d" % a(x,y#map(lambda y:i(x,y),h~#" ".join(j(x)#"\\n".
join(map(k,h~))""".replace("~","()").replace("#",")!")
).split("!")[n])
print l()
</code></pre>and I can find much nastier things written in Java, which means you can write bad and incomprehensible programs in any language, and probably rookies can do it only because they are naive.<br />
However, full potential of the developers may not be unleashed unless the language provide the highest level abstraction mechanisms, and in this case languages like Java and PHP are pretty bad while Perl outperforms Python and Ruby easily, disqualifying any possibility to label Perl as archaic.<br />
Perl can be as corporate as any other language, and mastering this language in an organization is an investment where the code can be used and reused in many ways: from systems administrators to developers, via the database managers etc., and in solutions ranging from simple command line operation to the development a corporate application.Jose Reyhttp://www.blogger.com/profile/15071755167581242815noreply@blogger.com5