Oodler 577

Introduction

I have been leaning very heavily on Perl's prototype feature for creating new modules. The imptetus for this can traced back to the day I looked at the source code for Try::Tiny, and realized that it was implemented using prototypes. The main reason for using prototypes for many new modules I've created recently is my focus on making a thing I do repeatedly available in a more Perlish or idiomatic way.

Required reading if you have not and are about to dive into an article about prototypes: Far More Than Everything You've Ever Wanted to Know about Prototypes in Perl by Tom Christiansen.

The following article demonstrates 2 CPAN modules I have written that focus more on Perl programmer UX and why Perl prototypes can provide a way forward for a great many ideas that people have. Prototypes misunderstood, yes; but more so, they are misunderestimated. They are infact, very powerful and when used for their intended purpose; a lot of hand wringing can be avoided during feature discussions.

Recent Examples on CPAN

Two such examples that I've written and uploaded to CPAN (PAUSE ID: OODLER) are:

• Try::ALRM (try/catch/retry like semantics for alarm and ALRM handling
• Dispatch::Fu - one HASH based dispatcher to rule them all^tm

Try::ALRM

I discussed Try::ALRM in a 2022 Perl Advent article, so I won't go into it other than to say that it's an idiomatic way to deal with alarm in the same way as die is handled by Try::Tiny. Once I realizeed that an ALRM signal was thrown like an exception and handled directly by $SIG{ALRM}, it made perfect sense to have a try kind of interface. The benefit to this kind of UX alignment is that it makes a retry extension to the structure very natural and easy.

  try_once {  
    my $nread = sysread $socket, $buffer, $size;  
  }
  finally {  
    my ($attempt, $successful) = @_;  
    if (not $successful) {  
       ... timed out  
    }  
    else {  
      ... didn't  
    }
  } timeout => $timeout;

Dispatch::Fu

I recently uploaded a module to CPAN called Dispatch::Fu because I was watching a lot of hand wringing (more than usual) on the p5p mailing list abou smartmatch, given/when, and different kinds of switch statements.

Having grappled with this problem from a different angle before, I felt like I recognized all of these cases as more general forms of something a lot of Perl developers learn to love, i.e., HASH based dispatching. This can be especially powerful for converting a long if/elsif/else chain (that is technically O(num_branches)) into a constant time O(1) HASH look up if there is a static string suitable for use as a HASH key. For example, this if block can be converted to a HASH dispatch table quite readily:

  if ($cgi->param("action") eq q{show_form}) {
   ...
  }
  elsif ($cgi->param("action") eq q{process_form}) {
   ...
  }
  elsif ($cgi->param("action") eq q{show_thankyou_html}) {
   ...
  }
  else {
   ...
  }

Would become:

  my $action = $cgi->param("action");
  my $actions = {
    show_form          => sub { ... },
    process_form       => sub { ... },
    show_thankyou_html => sub { ... },
    default            => sub { ... }, # the 'else' BLOCK
  }
  $action = q{default} if (not $action or not exists $actions->{$action});
  $actions->{$action}->();

The Problem with Traditional Dispatching

This works because $action is in this case (and of is in old school CGI.pm applications), a proper string. But idiom quickly breaks down in the following case,

  if ($cgi->param("action") eq q{foo} and $cgi->param("userid") != 0) {
   ...
  }
  elsif ($cgi->param("action") eq q{show_thankyou_html}) {
   ...
  }
  else {
   ...
  }

The Solution to Complicated Dispatching

Dispatch::Fu

was created to expose, in a _Perlish_ and structure way, a pattern that allows the programmer to reduce an arbitrary condition into a specific named case, then dispatch the action based on that. Using `Dispatch::Fu`, this would turn into the following:

  use Dispatch::Fu;
  dispatch {
    my $cgi = shift;
    if ($cgi->param("action") eq q{foo} and $cgi->param("userid") != 0) {
      return "foo";
    }
    elsif ($cgi->param("action") eq q{show_thankyou_html}) {
      return "thanks";
    }
    else {
      return "default";
    }
  } $cgi,
  on foo     => sub { ... },
  on thanks  => sub { ... },
  on default => sub { ... };

Given that example, readers should be able to see the value in this approach. The implementation of Dispatch::Fu is tiny and it is fast. All of the complexity is also put onto the shoulders of the programmer in how they implement the dispatch BLOCK that is used to determine what case name to return for immediate execution.

How Does Dispatch::Fu Work?

The remainder of this article will describe how Dispatch::Fu uses Perl prototypes to work. At the time of this writing, Dispatch::Fu in its entirety follows,

  package Dispatch::Fu;

  use strict;
  use warnings;
  use Exporter qw/import/;

  our $VERSION   = q{0.95};
  our @EXPORT    = qw(dispatch on);
  our @EXPORT_OK = qw(dispatch on);

  sub dispatch (&@) {
      my $code_ref  = shift;    # catch sub ref that was coerced from the 'dispatch' BLOCK
      my $match_ref = shift;    # catch the input reference passed after the 'dispatch' BLOCK

     # build up dispatch table for each k/v pair preceded by 'on'
      my $dispatch = {};
      while ( my $key = shift @_ ) {
          my $HV = shift @_;
          $dispatch->{$key} = _to_sub($HV);
      }

      # call $code_ref that needs to return a valid bucket name
      my $key = $code_ref->($match_ref);

      die qq{Computed static bucket not found\n} if not $dispatch->{$key} or 'CODE' ne ref $dispatch->{$key};

      # call subroutine ref defined as the v in the k/v $dispatch->{$key} slot
      return $dispatch->{$key}->();
  }

  sub on (@) {
      return @_;
  }

  sub _to_sub (&) {
      shift;
  }
  1;

Before I begin to explain what is happening, it is important to clearly define what a Perl prototype is not and what it is.

• Perl prototypes is not a system for creating named parameters
• Perl prototypes is not a system for describing parameter signatures
• Perl prototypes is a way to describe Perl data type coersions
• Perl prototypes is a way to achieve Perl keyword-like or built-in functions calling UX
• Perl prototypes does use declarative, templated DSL⁺

(⁺Much like (distinctly) with pack or printf)

This table from perlsub is extremely informative and pretty much says it all, which is a lot!:

  > perldoc perlsub
  ...
  **Declared as             Called as**
  sub mylink ($$)         mylink $old, $new
  sub myvec ($$$)         myvec $var, $offset, 1
  sub myindex ($$;$)      myindex &getstring, "substr"
  sub mysyswrite ($$$;$)  mysyswrite $buf, 0, length($buf) - $off, $off
  sub myreverse (@)       myreverse $x, $y, $z
  sub myjoin ($@)         myjoin ":", $x, $y, $z
  sub mypop (\@)          mypop @array
  sub mysplice (\@$$@)    mysplice @array, 0, 2, @pushme
  sub mykeys (\[%@])      mykeys $hashref->%*
  sub myopen (*;$)        myopen HANDLE, $name
  sub mypipe (**)         mypipe READHANDLE, WRITEHANDLE
  sub mygrep (&@)         mygrep { /foo/ } $x, $y, $z
  sub myrand (;$)         myrand 42
  sub mytime ()           mytime

What this table doesn't tell you, is that you may magnify the effect of prototypes by combining them together in creative ways. It also fails to suggest that you may create utility methods that do thing like convert a bare lexical block into a subroutine reference. For example, using the method defined with a prototype above, _to_sub, this works as expected:

  my $CODE_ref = _to_sub {
    my @ARGS = @_
      return printf qq{Hi, there: %s!!!\n}, join('and ', @ARGS);
    };
...
    $CODE_ref->(qw/Billy Jean/);

And how doe that work? Consider the suboutine, _to_sub:

  sub _to_sub (&) {
      shift;
  }

The ampersand & in _to_sub(&) is a template that tells perl to convert any thing passed in a lexical block into a subroutine reference. MAGIC HAPPENS. Then the updated @_ is available to shift. For the uninitiated, the above is explicitly equivalent to:

  sub _to_sub (&) {
      my $code_ref = shift;
      return $code_ref;
  }

So what's shift'd to $code_ref (i.e., the lexical block, { ... }) has already been coerced into a CODE reference. Yes, it's MAGIC. Another example of composing prototypes is the implementation of the on keyword:

  sub on (@) {
      return @_;
  }

In the context of other keywords, this is a null accumulator there merely for the UX of the whole thing. I.e., it just keeps rolling things to its right into an array. E.g.,

  dispatch {
  ...
  } $cgi,
  on foo     => sub { ... },
  on thanks  => sub { ... },
  on default => sub { ... };

Could validly be written as,

  dispatch {
  ...
  } $cgi,
   foo     => sub { ... },
   thanks  => sub { ... },
   default => sub { ... };

If you are thinking on is just a hint for mere mortals, then you are correct!

And now it can be pointed out that dispatch is really just set up to take a list of things; the first thing is a CODE reference (coerced by &), the second thing is the SCALAR reference that is passed to $code_ref as its only parameter (see dispatch's implementation above) that is rolled into @; then the rest of @, which contains all the case/sub pairs:

  sub dispatch (&@) {
     my $code_ref  = shift; # captures lexical block, { ... }
     my $match_ref = shift; # captures $CASES
     ...

There rest of the call just builds up the $dispatch HASH reference, calls $code_ref by passing in $match_ref, then assumes $code_ref will return a key that is contained in $dispatch. Then that key is used to call the subroutine assumed to be stored in $dispatch by reference. Thats it!

More Hidden Features of Prototypes Remain

In all my years, I have not seen a lot written on prototypes other than FUD. I certainly have not seen anything that aimed to expose interesting structures or even classes of structures. I believe I may have just scratched the surface of what is possible, and I encourage others to explore the hidden taxonomy of structures that seems to be lurking just below the surface.

For example, the general structure of Dispatch::Fu is covered in the table above as mygrep { /foo/ } $x, $y, $z. The on keyword is effectively putting syntactical sugar around the creation of the list on the lefthand side of the mygrep BLOCK.

The other thing to not with this structure is that there is no comma immediately after the BLOCK, but commas are required there after. Using on, the requirement to have a successive trail of commas (recall => is equivalent to a comma, often called the Texas comma) is broken; the pattern is therefore:

  dispatch BLOCK REF,
  on string1 => CODE,
  on string2 => CODE,
  ...,
  on stringN => CODE; 

But the accumulator, on(@) as defined effectively works to filter out the on. I think that is an interesting effect, and the current system can be exploited to do some very interesting things with syntax structure. Which means it is equivalent to,

  dispatch BLOCK REF, string1, CODE, strint2, CODE, ..., stringN, CODE;

And this is where the mygrep pattern becomes apparent:

  mygrep   {...} $x,  $y,      $z, ...;

If you have noticed or done anything interesting to exploit Perl prototype syntax in interesting or surprising ways, please let everyone know in the comments below. Untill next time, take care!