Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Wasting time with Parse::RecDescent and POE

by rob_au (Abbot)
on Mar 21, 2003 at 12:54 UTC ( #244841=sourcecode: print w/ replies, xml ) Need Help??

Category: Fun Stuff
Author/Contact Info rob_au
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;

Comment on Wasting time with Parse::RecDescent and POE
Download Code
Re: Wasting time with Parse::RecDescent and POE
by particle (Vicar) on Mar 21, 2003 at 16:34 UTC

    nice node, looks fun. unfortunately, i get 'Client 2 got connect error 10061 (Unknown error)' when i run either client or server. i'm not familiar with POE, so i don't have a great place to start debugging. if you have any ideas, i'm sure this script would cheer me up on a dreary friday.

    ~Particle *accelerates*

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://244841]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (7)
As of 2014-08-21 22:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (144 votes), past polls