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