Obsolete Your Idols » perl

The Bot Who Came In Out of the Cold

binder — Sun, 19 Apr 2009 18:22:00 +0000

I’ve now sunk a number of hours into it and added some functionality, none of which really works yet. But in the interest of keeping things going, here’s where things stand now. Explore doesn’t quite work, and there are still weird undef matches in the dialogue. But I pulled out all of Expect.pm and went to Smart::Comments.



#!/usr/bin/perl



# mudbot by Shannon Prickett 

# connect a pandorabots.com chatbot with a particular TinyMUCK, Pegasus.



package mudbot;



use Smart::Comments;

use Modern::Perl;

use Net::Telnet;

use Net::AIML;

use DB_File;



use vars qw{$being_quiet %global_exit $mud_connection $mud_conversation $mud_host $mud_name

            $mud_pass $mud_port $mud_sent $pid $robot %room_name };

use subs qw{setup};



$mud_host       = 'ginka.armageddon.org';

$mud_port       = '4242';

$mud_name       = 'Somebot';

$mud_pass       = 'YRMEME';

$being_quiet    = 0;

$pid            = $$;



tie %room_name, 'DB_File', 'mapfile' or

    die "can't tie to mapfile: $!\n";



$robot          = Net::AIML->new( botid => 'GETFROMPANDORABOTS' ); 



$mud_connection = new Net::Telnet( Host => $mud_host, Port => $mud_port )

                    or die "Can't connect to $mud_host $mud_port: $!";



setup( $mud_connection );



TALKLOOP: while (1) {

    ### TALKLOOP start



    my $atme = 0;

    my $prematch = '';

    my $postmatch = '';

    my $who_said;



    my ($stub_said, $what_said) = 

        $mud_connection->waitfor(   Match => '/ says, ".*"/',

                                    Errmode => 'return', );



    next TALKLOOP unless defined $what_said;



    $stub_said =~ qr{ START \d+ .+ \b(\w+)\b }msx;

    $who_said = $1;



    $what_said =~ s{says, \"(.*)\"}{$1}g;



    ### Got: $who_said  

    ### Got: $what_said



    if ($what_said =~ qr{$mud_name}msxi){

        ### saw my name

        $atme = 1;

    }



    $what_said =~ s{$mud_name}{}g;



    if ( ($atme) && ($what_said =~ qr{QUIT}) ) {

        $mud_connection->print("QUIT");

        exit;

    }



    if ( ($atme) && ($what_said =~ qr{be quiet}) ) {

        if ($being_quiet) {

            $mud_connection->print("say Maximum verbosity achieved.");

            $being_quiet = 0;

        } else

        {

            $mud_connection->print("say Shutting up now.");

            $being_quiet = 1;

        }

    }



    if ( ($atme) && ($what_said =~ qr{search for '(.*)'}msxi) ) {

        my $terms = $1;

        my @terms = split $terms;

        my $querystring = join '+', @terms;

        $mud_connection->print("say Found http://lmgtfy.com/q=$querystring");

    }



    if ( ($atme) && ($what_said =~ qr{explore}) ) {

        $mud_connection->print("say OK, going to poke around now.");

        sleep 3;

        $mud_connection->print('home');

        goto EXPLORELOOP;

    }



    if ($being_quiet) {

        next TALKLOOP;

    }



    my $response = $robot->tell($what_said);

    if ($atme) {

        print "response: $response\n";

        speak( $response );

    }

    else {

        if ( !$being_quiet && (rand() > .75) ) {

            print "jumping in with $response\n";

            speak( $response );

        }

    }

}



EXPLORELOOP: while (1) {

    ### exploring



    my ($name, $desc);



    $mud_connection->print('look');

    my $startmark   = $mud_connection->getline( );

    $name           = $mud_connection->getline( );

    while (my $line = $mud_connection->getline( Errmode => 'return', )) {

        $desc .= $line;

    }



    $mud_connection->waitfor( Match => '/END$pid/', Errmode => 'return');

    chomp $name;

    chomp $desc;



    ### got: $name

    ### got: $desc



    $room_name{$name} = $desc;



    sleep 10;



    $mud_connection->print('out');

}



sub setup {

    my $mc = shift;



    $mc->dump_log('/home/binder/src/mb/logfile');



    $mc->waitfor('/connect\s+guest\s+guest/');

    $mc->print("connect $mud_name $mud_pass");



    $mc->waitfor('/Vote to ban the MisInformation SuperHighway/');

    $mc->print('@desc me=Just a Perl toy of Binder\'s.');



    $mc->print("OUTPUTPREFIX START$pid");

    $mc->print("OUTPUTSUFFIX END$pid");



    $mc->waitfor('/Description set/');

    $mc->print("home\nout\nvillage");

}



sub speak {

    my $response = shift;

    my @lines = split /\n/, $response;

    for my $line (@lines) {

        $mud_connection->print("say $line");

    }

}

Another Sixty Minutes Down

binder — Fri, 17 Apr 2009 16:40:03 +0000

And the bot is now both more and less annoying. Updated code below.



[[code]]czozNTE1OlwiDQojIS91c3IvYmluL3BlcmwNCg0KIyBtdWRib3QgYnkgU2hhbm5vbiBQcmlja2V0dCA8c3RwQG1hbmp1c3JpLm9yZz57WyYqJl19DQojIGNvbm5lY3QgYSBwYW5kb3JhYm90cy5jb20gY2hhdGJvdCB3aXRoIGEgcGFydGljdWxhciBUaW55TVVDSywgUGVnYXN1cy4NCntbJiomXX0NCnBhY2thZ2UgbXVkYm90Ow0KdXNlIE1vZGVybjo6UGVybDsNCnVzZSBOZXQ6OlRlbG5ldDsNCnVzZSBOZXQ6OkFJTUw7DQp1c2Uge1smKiZdfUV4cGVjdDsNCg0KdXNlIHZhcnMgcXd7JG11ZF9jb25uZWN0aW9uICRtdWRfY29udmVyc2F0aW9uICRtdWRfaG9zdCAkbXVkX25hbWV7WyYqJl19ICRtdWRfcGFzcyAkbXVkX3BvcnQgJG11ZF9zZW50ICRyb2JvdH07DQoNCiRtdWRfaG9zdCA9IFwnZ2lua2EuYXJtYWdlZGRvbi5vcmd7WyYqJl19XCc7DQokbXVkX3BvcnQgPSBcJzQyNDJcJzsNCiRtdWRfbmFtZSA9IFwnU29tZWJvdFwnOw0KJG11ZF9wYXNzID0gXCdZUk1FTUVcJzsNCg0KJHJ7WyYqJl19b2JvdCA9IE5ldDo6QUlNTC0+bmV3KCBib3RpZCA9PiBcJ0dFVFRISVNOVU1CRVJGUk9NUEFORE9SQUJPVFNcJyApOyANCg0KJG11ZF9je1smKiZdfW9ubmVjdGlvbiA9IG5ldyBOZXQ6OlRlbG5ldCggSG9zdCA9PiAkbXVkX2hvc3QsIFBvcnQgPT4gJG11ZF9wb3J0ICkNCiAgICBvciB7WyYqJl19ZGllIFwiQ2FuXCd0IGNvbm5lY3QgdG8gJG11ZF9ob3N0ICRtdWRfcG9ydDogJCFcIjsNCg0KJG11ZF9jb252ZXJzYXRpb24gPSBFeHBlY3tbJiomXX10LT5leHBfaW5pdCgkbXVkX2Nvbm5lY3Rpb24pOw0KDQokbXVkX2NvbnZlcnNhdGlvbi0+bG9nX2dyb3VwKDEpOw0KJG11ZF9jb252e1smKiZdfWVyc2F0aW9uLT5sb2dfdXNlcigxKTsNCiRtdWRfY29udmVyc2F0aW9uLT5sb2dfc3Rkb3V0KDEpOw0KJG11ZF9jb252ZXJzYXRpb257WyYqJl19LT5sb2dfZmlsZShcIi9ob21lL2JpbmRlci9zcmMvbWIvbG9nZmlsZVwiLCBcJ3dcJyk7DQoNCiRtdWRfY29udmVyc2F0aW9uLT5leHBlY3R7WyYqJl19KDMwLCAgIFwnLXJlXCcsIHFye2Nvbm5lY3QgICAgICAgIyBwcmV0dHkgc3RhbmRhcmQgTVVDSyBncmVldGluZw0KICAgICAgICAgICAge1smKiZdfSAgICAgICAgICAgICAgICAgICAgICAgIFxccysNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGd1ZXN0DQogICAge1smKiZdfSAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgXFxzKw0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZ3Vle1smKiZdfXN0fW1zeCwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHN1YiB7DQogICAgICAgICAgICAgICAgICAgICAgICAgICB7WyYqJl19ICAgICAgICAgbXkgJGZoID0gc2hpZnQ7DQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAkZmgtPnNlbmQoXCJjb257WyYqJl19bmVjdCAkbXVkX25hbWUgJG11ZF9wYXNzXFxuXCIpOw0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgfSk7DQoNCiRte1smKiZdfXVkX2NvbnZlcnNhdGlvbi0+ZXhwZWN0KDMwLCBcJ1ZvdGUgdG8gYmFuIHRoZSBNaXNJbmZvcm1hdGlvbiBTdXBlckhpZ2h3YXlcJywNCntbJiomXX0gICAgICAgICAgICAgICAgICAgICAgICAgICAgc3ViIHsNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbXkgJGZoID0ge1smKiZdfXNoaWZ0Ow0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAkZmgtPnNlbmQoXCJcXEBkZXNjIG1lPUp1c3QgYSBQZXJsIHRveXtbJiomXX0gb2YgQmluZGVyXCdzLlxcblwiKTsNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgfSk7DQoNCiRtdWRfY29udmVyc2F0aW9ue1smKiZdfS0+ZXhwZWN0KDMwLCBcJ0Rlc2NyaXB0aW9uIHNldFwnLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIHN1YiB7DQogICAgICAgIHtbJiomXX0gICAgICAgICAgICAgICAgICAgICAgICBteSAkZmggPSBzaGlmdDsNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgJGZoe1smKiZdfS0+c2VuZChcImhvbWVcXG5vdXRcXG52aWxsYWdlXFxuXCIpOw0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB9KTsNCg0KDQpUQXtbJiomXX1MS0xPT1A6IHdoaWxlICgxKSB7DQogICAgcHJpbnQgXCJUQUxLTE9PUCBzdGFydFxcblwiOw0KDQogICAgbXkgJGJlaW5nX3F1aWV0ID0ge1smKiZdfTA7DQogICAgbXkgJGF0bWUgPSAwOw0KICAgIG15ICRwcmVtYXRjaCA9IFwnXCc7DQogICAgbXkgJHBvc3RtYXRjaCA9IFwnXCc7DQoNCiAge1smKiZdfSAgbXkgJGluZGV4ID0gJG11ZF9jb252ZXJzYXRpb24tPmV4cGVjdCggNjAsIFwnLXJlXCcsIHFyeyBzYXlzLCBcIn0gKTsgIA0KDQogICB7WyYqJl19ICRwcmVtYXRjaCA9ICRtdWRfY29udmVyc2F0aW9uLT5iZWZvcmUoKTsNCiAgICAkcG9zdG1hdGNoID0gJG11ZF9jb252ZXJzYXRpb3tbJiomXX1uLT5hZnRlcigpOw0KICAgICRtdWRfY29udmVyc2F0aW9uLT5jbGVhcl9hY2N1bSgpOw0KDQogICAgbmV4dCBUQUxLTE9PUCB1bmxle1smKiZdfXNzICRwcmVtYXRjaDsNCg0KICAgICRwb3N0bWF0Y2ggPX4gc3tcXFwifXt9Ow0KICAgIHByaW50IFwiJHByZW1hdGNoIHNhaWQgJHBvc3R7WyYqJl19bWF0Y2hcXG5cIjsNCg0KDQogICAgaWYgKCRwb3N0bWF0Y2ggPX4gcXJ7JG11ZF9uYW1lfSl7DQogICAgICAgIHByaW50IFwic2F3IG15IHtbJiomXX1uYW1lXFxuXCI7DQogICAgICAgICRwb3N0bWF0Y2ggPX4gc3skbXVkX25hbWV9e1BlcnNlcGhvbmV9ZzsNCiAgICAgICAgJGF0bWUgPSB7WyYqJl19MTsNCiAgICB9DQoNCiAgICBpZiAoICgkYXRtZSkgJiYgKCRwb3N0bWF0Y2ggPX4gcXJ7UVVJVH0pICkgew0KICAgICAgICAkbXVkX3tbJiomXX1jb252ZXJzYXRpb24tPnNlbmQoXCJRVUlUXFxuXCIpOw0KICAgICAgICBleGl0Ow0KICAgIH0NCg0KICAgIGlmICggKCRhdG1lKSAmJiAoe1smKiZdfSRwb3N0bWF0Y2ggPX4gcXJ7YmUgcXVpZXR9KSApIHsNCiAgICAgICAgaWYgKCRiZWluZ19xdWlldCkgew0KICAgICAgICAgICAgJG17WyYqJl19dWRfY29udmVyc2F0aW9uLT5zZW5kKFwic2F5IE1heGltdW0gdmVyYm9zaXR5IGFjaGlldmVkLlxcblwiKTsNCiAgICAgICAgICAgICRiZXtbJiomXX1pbmdfcXVpZXQgPSAwOw0KICAgICAgICB9IGVsc2UNCiAgICAgICAgew0KICAgICAgICAgICAgJG11ZF9jb252ZXJzYXRpb24tPnNle1smKiZdfW5kKFwic2F5IFNodXR0aW5nIHVwIG5vdy5cXG5cIik7DQogICAgICAgICAgICAkYmVpbmdfcXVpZXQgPSAxOw0KICAgICAgICB9DQogICB7WyYqJl19IH0NCg0KICAgIGlmICgkYmVpbmdfcXVpZXQpIHsNCiAgICAgICAgbmV4dCBUQUxLTE9PUDsNCiAgICB9DQoNCiAgICBpZiAoJGF0bXtbJiomXX1lKSB7DQogICAgICAgIG15ICRyZXNwb25zZSA9ICRyb2JvdC0+dGVsbCgkcG9zdG1hdGNoKTsNCiAgICAgICAgcHJpbnQgXCJyZXNwb3tbJiomXX1uc2U6ICRyZXNwb25zZVxcblwiOw0KICAgICAgICAkbXVkX2NvbnZlcnNhdGlvbi0+c2VuZChcInNheSAkcmVzcG9uc2VcXG5cIik7DQogICB7WyYqJl19IH0NCiAgICBlbHNlIHsNCiAgICAgICAgaWYgKCAhJGJlaW5nX3F1aWV0ICYmIChyYW5kKCkgPiAuNzUpICkgew0KICAgICAgICAgIHtbJiomXX0gIHByaW50IFwianVtcGluZyBpblxcblwiOw0KICAgICAgICAgICAgbXkgJHJlc3BvbnNlID0gJHJvYm90LT50ZWxsKCRwb3N0bWF0Y2gpe1smKiZdfTsNCiAgICAgICAgICAgIHByaW50IFwicmVzcG9uc2U6ICRyZXNwb25zZVxcblwiOw0KICAgICAgICAgICAgJG11ZF9jb252ZXJzYXRpb257WyYqJl19LT5zZW5kKFwic2F5ICRyZXNwb25zZVxcblwiKTsNCiAgICAgICAgfQ0KICAgIH0NCn0NCmNvbnRpbnVlIHsNCiAgICAkbXVkX2NvbnZlcntbJiomXX1zYXRpb24tPmNsZWFyX2FjY3VtKCk7DQp9DQpcIjt7WyYqJl19[[/code]]

The Sixty Minute MUDbot.

binder — Fri, 17 Apr 2009 07:13:56 +0000

I decided to scratch an itch and practice a little bit of the Manifesto of the Cult of Done tonight. So I wrote a clunky and fragile Perl wrapper which ties a chatbot to a MUCK. Here’s the code.





#!/usr/bin/perl



# mudbot by Shannon Prickett 

# connect a pandorabots.com chatbot with a particular TinyMUCK, Pegasus.



package mudbot;

use Modern::Perl;

use Net::Telnet;

use Net::AIML;

use Expect;



use vars qw{$mud_connection $mud_conversation $mud_host $mud_name $mud_pass $mud_port $mud_sent $robot};



$mud_host = 'ginka.armageddon.org';

$mud_port = '4242';

$mud_name = 'Somebot';

$mud_pass = 'YRMEME';



$robot = Net::AIML->new( botid => 'GETTHISNUMBERFROMPANDORABOTS' ); 



$mud_connection = new Net::Telnet( Host => $mud_host, Port => $mud_port )

    or die "Can't connect to $mud_host $mud_port: $!";



$mud_conversation = Expect->exp_init($mud_connection);



$mud_conversation->log_group(1);

$mud_conversation->log_user(1);

$mud_conversation->log_stdout(1);

$mud_conversation->log_file("/home/binder/src/mb/logfile", 'w');



$mud_conversation->expect(30,   '-re', qr{connect       # pretty standard MUCK greeting

                                    \s+

                                    guest

                                    \s+

                                    guest}msx, 

                                sub {

                                    my $fh = shift;

                                    $fh->send("connect $mud_name $mud_pass\n");

                                    });



$mud_conversation->expect(30, 'Vote to ban the MisInformation SuperHighway',

                            sub {

                                my $fh = shift;

                                $fh->send("\@desc me=Just a Perl toy of Binder's.\n");

                                });



$mud_conversation->expect(30, 'Description set',

                            sub {

                                my $fh = shift;

                                $fh->send("home\nout\nvillage\n");

                                });



while (1) {

    my $command;

    $mud_conversation->expect(3, 

                             '-re', 

                             qr{ Somebot }msx, 

                             sub {  my $fh = shift;

                                    $command = $mud_conversation->after();

                                    $command =~ tr{\,\"\.\!}{}d;

                                    print "matched: $command\n";

                                    if ($command =~ qr{QUIT}) {

                                        $fh->send("QUIT\n");

                                        exit;

                                    } else

                                    {

                                        if (length($command)>3) {

                                            my $response = $robot->tell($command);

                                            $fh->send("say $response\n");

                                        } 

                                    }

                                }

                            );

}