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