Forking Perl with Select

From Beautifulcode

architecture overview: deadlocks are avoided by using a robust queueing mechanism and ignoring redundant or late Go! shouts. See pre-box #3.

Why is this solution beautiful? With only two methods, there is no unnecessary cruft. The two methods could be implemented in any language, offering the contest participants their choice of implementation language without a big porting task to support the different languages. Any language that can to getc and putc will work.

For even easier contest participation, the socket to the participant could be appear as the stdin and stdout of an exec'd process instead of merely a launched library, with newlines bounding all the communications.

---

I've sort of done this before, with the Solitaire 500 challenge in the Perl Journal in 1996, but here you go

Invocation:

the program takes the names of the competing modules, each its own well-formed package file, as command line arguments.

For each of the modules, a bidirectional pipe is created, a fork is done, and then the module is loaded.

The tiles are shuffled.

Seven letters are written to each pipe's buffer, and a select loop is entered.

Referee to player mini-language: A-Z represent new letters.

Player to referee mini-language: "GO!\n" means I have completed my current puzzle.

Deadlocks are avoided by using non-blocking select and explicit buffers and only writing one character at a time. (which is silly, because the buffer is going to be bigger than 15 letters, but still) (the code below assumes that the pipe buffer can hold 15 chars, so doesn't bother with output buffers. ) (no it doesn't, it handwaves output buffering)

Verifying the correctness of player solutions is outside the scope of the problem.

Here's Speedscrabble.pl:

package main;

use Socket;

for $player (@ARGV){
      my ($RefEnd, $PlayerEnd);
      socketpair($RefEnd, $PlayerEnd, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
      if(fork){
          # parent, stay ref
          close $PlayerEnd;
          push @Players, $RefEnd;
          STUB make $RefEnd a "hot pipe" with non-buffered writes
      }else{
          # child, become player
          close $RefEnd;
          require $player;
          $player->START;
          die "$$: player $player returned from START";
      };
};

@LetterPool = qw / W H A T E V E R 
                  A L L     T H E   S C R A B B L E 
         T I L E S    G O   H E R E
/;

# distribute initial tiles
for (1 .. 7 ) {
    for my $P (@Players){
        print $P, shift @LetterPool
    };
};

for (;;){  # endless loop

      STUB compose selectmask from @Players (see Http::Server::Singlethreaded for working code)
         output buffers are an array indexed by file descriptor number
         players with data in their output buffers, we care if they are writable
         we care if everyone is readable

      STUB call select function

      if (any players are readable AND have nothing in their outputbuffers){
           read 4 chars from the player, should be "GO!\n"
           pop from LetterPool into everyone's output buffer
      };

      if any other players are readable, read 4 chars from them as well

      all players with data in their output buffer get a character if they are writable

};


package IPlayScrabble;
=pod

provide the LetterIfLetter and ShoutGO functions

provide @WordList word array

=cut

BEGIN {
    chomp @WordList = `cat /usr/share/dict/words`;
};


sub LetterIfLetter(){
   STUB "check $PlayerEnd for readibility or return false";
   STUB "read one char from $PlayerEnd and return it"; 
}

sub ShoutGO(){
   IsReadable($PlayerEnd) and return; # in case someone else shouted Go!
   print "$main::player shouting GO\n";
   print $PlayerEnd "GO!\n";
   1 while !IsReadable( $PlayerEnd); # guarantee that LIL won't miss a letter
};

and here's a really poorly behaved (but slow) player called ScrabbleIdiot.pm

package ScrabbleIdiot;
@ISA = qw/IPlayScrabble/;  # OO because that's what the spec says
bless \(my $me);          

my @MyLetters;
push @MyLetters, $me->LetterIfLetter for 1..7; # take initial seven tiles

use Time::HiRes 'sleep';

sub START{
   for (8..15){
     sleep( 1 + rand 3);
     print "$$: [@MyLetters] is a word, isn't it?\n";
     my $nextletter = $me->LetterIfLetter;
     if (!$nextletter){
       $me->ShoutGO(); # for referee solution checking, ShoutGO(join '',@MyLetters);
       $nextletter = $me->LetterIfLetter;
     };
     push @MyLetters, $nextletter;

     # scramble provided letters randomly (because we're an Idiot)
     for my $i (0..$#MyLetters){
         my $r = int rand @MyLetters;
         @MyLetters[$i,$r] = @MyLetters[$r,$i];
     };
   };
   print "$$: Scrabble Idiot wins, with [@MyLetters]! please check my solutions\n";
};

1;

you could invoke like so:

perl Speedscrabble.pl ScrabbleIdiot

So. Two methods available to the player, LetterIfLetter and ShoutGO, and a well-defined place to find the wordlist. A convention for output to STDOUT for status. The big deadlock possibility, which is two players simultanously shouting GO!, is taken care of by ignoring the second one: when there is a GO! from a player who has a referee-queued letter (has not called LetterIfLetter yet to receive it) that GO! is ignored.

proving it's correct. The possible tricky situations are when two players shout Go! at the same time. I assume that the OS instantly updates pipes for readability as soon as there is something written to one.

if we really must go threaded, we could have a shared flag indicating "someone has shouted Go!" and a mutex in the ShoutGo function. Forked and selecting, we can just follow the following table:

name of situation           someone else shouted go! too           what happens

happy path                  no                                     everybody gets a tile

tie                         yes                                    everybody gets a tile

late                        not only that but we've already        we get ignored
                            been issued a tile that we haven't
                            picked up