Perl Advent Calendar 2007-12-25

I can hardly wait

by Jerrad Pierce

This kids were so excited I had to build a countdown clock to stop the ceaseless, "Is it Christmas yet? Is it Christmas yet?" Unfortunately, Time::Out, which annoyingly fails to auto-export its sole routine, cannot help with this even though it provides timers of a sort. It's very easy to forget that the module does not execute your code for a prescribed amount of time, but instead interrupts running code after the requested period has elapsed. I find this confusion to be exacerbated by the module's interface. If we had some of the more versatile lvalue handling schemes proposed for Perl 6 it'd be possible to implement a slightly saner syntax:

timeout {
         ... #Block
	} @opts = $econds;

with a natural idiom for explicit provision of (optional) parameters instead of that on line 29. Failing that, the following (after this patch) is not a bad approximation, particular as the use of arrayref isn't strictly necessary:

timeout {
         ... #Block
	} [@opts] => $econds;

So what are the merits of the module? Well, if you've ever used alarm you may have struggled with the annoyance of only being able to set a single alarm at any time. Time::Out works a little magic behind the scenes to offer multiple concurrent alarms. An example system employing this facility is the game described here:

• 60 seconds to provide as many words as possible, each beginning with a different letter of the alphabet.
• 3 seconds to enter any given word.
• The longer the word, the more it is worth.
• A word's value increases in fold for each instance of the initial character.
• The values of words not found in the system dictionary are deducted from your total score.

mod25.pl

   1 #This game is not playable on Win32 due to blocking I/O
   2 INIT{ $| = 1 }
   3 
   4 use Time::Out 'timeout';
   5 use Search::Dict;
   6 
   7 #Time to play, time per word
   8 my($tt, $tw, %words, %yet) = (60, 3);
   9 #Word list
  10 my $dict = '/usr/share/dict/words';
  11 
  12 #Isolate sleep from alarm for cheesy async timer
  13 if( fork ){
  14     &timer;
  15 }
  16 else{
  17     %yet = map{ $_=>0 } a..z;
  18     timeout $tt => \&wrapper;
  19     printf "\n\nTotal score, %i\n", score();
  20 }
  21 
  22 sub wrapper{
  23     for(my $i=0; $i<26; $i++){
  24 	printf "\nletter? [%s]", join('', sort keys %yet);
  25 
  26 	my $l = substr(lc(<STDIN>), 0, 1);
  27 
  28 	#Funky syntax if you want to pass args
  29 	timeout($tw => $l, \&word) if
  30 	    #Alpha only, no retries
  31 	    $l =~ /\w/ && exists($yet{$l});
  32     }
  33 }
  34 
  35 sub word{
  36     my $l = shift;
  37 
  38     print "word? ";
  39     chomp( my $w = <STDIN> );
  40 
  41     return unless substr($w, 0, 1) eq $l;
  42     $words{$l} = $w;	
  43     delete($yet{$l});
  44 }
  45 
  46 
  47 #Supporting routines
  48 sub timer{
  49     return unless $tt;
  50     printf "\r%s%02i ", "\t"x5, --$tt;
  51     sleep 1;
  52     &timer;
  53 }
  54 
  55 sub score{
  56     my $ts = 0;
  57     open(my $dict, $dict);
  58 
  59     print "\n";
  60 
  61     while( my($k, $v) = each %words ){
  62 	print "\n$v... ";
  63 
  64 	my($ws, $bogus) = (0, 0);
  65 	$ws = length $v;
  66 	$ws *= eval "$v =~ y/$k//";
  67 
  68 	$bogus = look($dict, $v, 1, 1) < 0 ? 1 :
  69 	    (chomp($_=readline($dict)), $_) ne $v;
  70 
  71 	if( $bogus ){
  72 	    print STDERR "not found, deducting $ws";
  73 	    $ws *= -1;
  74 	}
  75 	else{
  76 	    print STDERR "is valid, awarding $ws";
  77 	}
  78 	$ts += $ws;
  79     }
  80     return $ts;
  81 }