| Description: |
After having had what has seemed to be an eternally long week at work this last week, I sought to put something fun together to kill some time. Given that much of my work of this week has been split between data munging with Parse::RecDescent and application development with POE, I thought, "Why not combine the two?".
The result is the following code which uses the Abbott and Costello "Who's on First?" grammar written by Damian Conway for his article "the man(1) of Descent" in Issue 12 of The Perl Journal in a POE based "chatter" application.
This script, when called without any arguments, takes on the role of Bud Abbott and establishes a TCP server, on port 12477, for communication. When called with a hostname as a single argument, this script connects to the server component on that host and plays the complementary role of Lou Costello. |
#!/usr/bin/perl
use Parse::RecDescent;
use POE;
use POE::Component::Client::TCP;
use POE::Component::Server::TCP;
use POE::Filter::Line;
use Socket;
use strict;
use vars qw/ %base %man @try_again /;
%man =
(
'first' => "Who",
'second' => "What",
'third' => "I Don't Know"
);
%base = map { lc } reverse %man;
@try_again =
(
"So, who's on first?",
"I want to know who's on first!",
"What's the name of the first baseman?",
"Let's start again. What's the name of the guy on first?",
"Okay, then, who's on second?",
"Well then, who's on third?",
"What's the name of the fellow on third?"
);
sub Parse::RecDescent::choose { $_[1 + int rand $#_]; }
my $hostname = gethostbyname( $ARGV[0] || '' );
if ( defined $hostname )
{
my $costello = Parse::RecDescent->new( q{
Interpretation:
Meaning <reject: $item[1] eq $thisparser->{'prev'} >
{ $thisparser->{'prev'} = $item[1] }
| { choose( @::try_again ) }
Meaning:
Question
| UnclearReferent
| NonSequitur
Question:
Preface Interrogative /[i']s on/ Base
{
choose(
"Yes, what is the name of the guy on $item[2]?
+",
"The $item[4] baseman?",
"I'm asking you! $item[2]",
"I don't know"
);
}
| Interrogative
{
choose(
"That's right, $item[1]?",
"What?",
"I don't know!"
);
}
UnclearReferent:
"He's on" Base
{
choose(
"Who's on $item[2]?",
"Who is?",
"So, what is the name of the guy on $item[2]?"
);
}
NonSequitur:
( "Yes" | "Certainly" | /that's correct/i )
{
choose(
"$item[1], who?",
"What?",
@::try_again
);
}
Interrogative:
/who/i | /what/i
Base:
'first'
| 'second'
| 'third'
Preface:
...!Interrogative /\S*/
});
POE::Component::Client::TCP->new(
'RemoteAddress' => inet_ntoa( $hostname ),
'RemotePort' => 12477,
'Filter' => 'POE::Filter::Line',
'Connected' => sub
{
print STDOUT "<costello> Who's on first?\n";
$_[ HEAP ]->{'server'}->put( "Who's on first?" );
},
'ServerInput' => sub
{
my ( $heap, $line ) = @_[ HEAP, ARG0 ];
my $reply = $costello->Interpretation( $line );
print STDOUT "<abbott> ", $line, "\n";
sleep 1;
print STDOUT "<costello> ", $reply, "\n";
$heap->{'server'}->put( $reply );
}
);
}
else
{
my $abbott = Parse::RecDescent->new( q{
Interpretation:
ConfirmationRequest
| NameRequest
| BaseRequest
ConfirmationRequest:
Preface(s?) Name /[i']s on/ Base
{
( lc $::man{ $item[4] } eq lc $item[2] )
? "Yes"
: "No, $::man{ $item[4] }\'s on $item[4]"
}
| Preface(s?) Name /[i']s the (name of the)?/ Man /('s n
+ame )?on/ Base
{
( lc $::man{ $item[6] } eq lc $item[2] )
? "Certainly"
: "No. \u$item[2] is on " . $::base{ lc $ite
+m[2] }
}
BaseRequest:
Preface(s?) Name /(is)?/
{ "He's on " . $::base{ lc $item[2] } }
NameRequest:
/(What's the name of)?the/i Base "baseman"
{ $::man{ $item[2] } }
Preface:
...!Name /\S*/
Name:
/who/i
| /what/i
| /i don't know/i
Base:
'first'
| 'second'
| 'third'
Man:
'man'
| 'guy'
| 'fellow'
});
POE::Component::Server::TCP->new(
'Alias' => 'server',
'Port' => 12477,
'ClientInput' => sub
{
my ( $heap, $line ) = @_[ HEAP, ARG0 ];
my $reply = $abbott->Interpretation( $line );
print STDOUT "<costello> ", $line, "\n";
sleep 1;
print STDOUT "<abbott> ", $reply, "\n";
$heap->{'client'}->put( $reply );
}
);
}
$poe_kernel->run;
exit 0;
|
