xavierbot.pl

   1 #!/usr/bin/perl -wT
   2 # xavierbot : an OCaml interpreter IRC bot.
   3 # By Richard W.M. Jones <rich@annexia.org>.
   4 # This code is in the Public Domain.
   5 # $Id: xavierbot.pl,v 1.4 2007/06/28 20:49:10 rjones Exp $
   6
   7 use strict;
   8
   9 use POE qw(Component::IRC Wheel::Run);
  10
  11 $ENV{PATH} = "/usr/bin:/bin";
  12
  13 #----------------------------------------------------------------------
  14 # Start of configuration.
  15
  16 my $nick = "xavierbot";
  17 my $ircname = "Xavierbot";              # Printable name.
  18 my $server = "chat.freenode.net";
  19 #my $server = "devserv.devel.redhat.com";
  20 my $port = 6667;
  21 my $channel = "#ocaml";
  22
  23 # End of configuration.
  24 #----------------------------------------------------------------------
  25
  26 POE::Session->create (
  27   package_states => [
  28     main => [ qw(_default _start irc_001 irc_public got_stdout) ],
  29   ],
  30 );
  31
  32 POE::Kernel->run ();
  33 exit 0;
  34
  35 sub _start
  36 {
  37     my ($kernel, $heap) = @_[KERNEL,HEAP];
  38
  39     my $irc = POE::Component::IRC->spawn
  40         (
  41          nick => $nick,
  42          ircname => $ircname,
  43          server => $server,
  44          port => $port,
  45          ) or die "POE::Component::IRC->spawn failed: $!";
  46
  47     my $ocaml = POE::Wheel::Run->new
  48         (
  49          Program => "./ocamlbotwrapper",
  50          StdoutEvent => "got_stdout",
  51          StderrEvent => "got_stdout",
  52          ) or die "POE::Wheel::Run->new ./ocamlbotwrapper failed: $!";
  53
  54     $heap->{irc} = $irc;
  55     $heap->{ocaml} = $ocaml;
  56
  57     my $irc_session = $heap->{irc}->session_id ();
  58     $kernel->post ($irc_session => register => "all");
  59     $kernel->post ($irc_session => connect => { });
  60
  61     undef;
  62 }
  63
  64 sub irc_001
  65 {
  66     my ($kernel, $sender) = @_[KERNEL,SENDER];
  67
  68     my $poco_object = $sender->get_heap ();
  69     print "Connected to ", $poco_object->server_name (), "\n";
  70
  71     $kernel->post ($sender => join => $channel);
  72     undef;
  73 }
  74
  75 sub irc_public
  76 {
  77     my ($kernel, $sender, $who, $where, $what, $heap) =
  78         @_[KERNEL,SENDER,ARG0,ARG1,ARG2,HEAP];
  79     my $nick = (split /!/, $who)[0];
  80     my $channel = $where->[0];
  81
  82     print "got: $what\n";
  83     if (my ($stmt) = $what =~ /^\s*([^#].*;;)\s*$/) {
  84         print "stmt = $stmt\n";
  85         $heap->{ocaml}->put ("$stmt\n");
  86     }
  87     undef;
  88 }
  89
  90 sub _default
  91 {
  92     my ($event, $args) = @_[ARG0 .. $#_];
  93     my @output = ("$event: ");
  94
  95     foreach my $arg (@$args) {
  96         if (ref ($arg) eq "ARRAY") {
  97             push @output, "[" . join (" ,", @$arg) . "]";
  98         } else {
  99             push @output, "'$arg'";
 100         }
 101     }
 102     print STDOUT join " ", @output, "\n";
 103     return 0;
 104 }
 105
 106 #----------------------------------------------------------------------
 107
 108 # Bot wrote something.
 109
 110 sub got_stdout
 111 {
 112     my ($kernel,$heap, $input, $wheel_id) = @_[KERNEL,HEAP,ARG0,ARG1];
 113     print "Child said: $input\n";
 114     $kernel->post ($heap->{irc} => privmsg => $channel => "$input");
 115 }