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.2 2007/06/28 16:22:33 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 = "devserv.devel.redhat.com";
  17 my $port = 6667;
  18
  19 my @channels = ("#ocaml");
  20
  21 # End of configuration.
  22 #----------------------------------------------------------------------
  23
  24 my $irc = POE::Component::IRC->spawn (
  25       nick => $nick,
  26       ircname => $ircname,
  27       server => $server,
  28       port => $port,
  29   ) or die "POE::Component::IRC->spawn failed: $!";
  30
  31 POE::Session->create (
  32   package_states => [
  33     main => [ qw(_default _start irc_001 irc_public) ],
  34   ],
  35   heap => { irc => $irc },
  36 );
  37
  38 $poe_kernel->run ();
  39 exit 0;
  40
  41 sub _start {
  42     my ($kernel, $heap) = @_[KERNEL,HEAP];
  43
  44     my $irc_session = $heap->{irc}->session_id ();
  45     $kernel->post ($irc_session => register => "all");
  46     $kernel->post ($irc_session => connect => { });
  47     undef;
  48 }
  49
  50 sub irc_001 {
  51     my ($kernel, $sender) = @_[KERNEL,SENDER];
  52
  53     my $poco_object = $sender->get_heap ();
  54     print "Connected to ", $poco_object->server_name (), "\n";
  55
  56     $kernel->post ($sender => join => $_ ) for @channels;
  57     undef;
  58 }
  59
  60 sub irc_public {
  61     my ($kernel, $sender, $who, $where, $what) =
  62         @_[KERNEL,SENDER,ARG0,ARG1,ARG2];
  63     my $nick = (split /!/, $who)[0];
  64     my $channel = $where->[0];
  65
  66     print "got: $what\n";
  67     if (my ($rot13) = $what =~ /^rot13 (.+)/) {
  68         $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M];
  69         $kernel->post ($sender => privmsg => $channel => "$nick: $rot13");
  70     }
  71     undef;
  72 }
  73
  74 sub _default {
  75     my ($event, $args) = @_[ARG0 .. $#_];
  76     my @output = ("$event: ");
  77
  78     foreach my $arg (@$args) {
  79         if (ref ($arg) eq "ARRAY") {
  80             push @output, "[" . join (" ,", @$arg) . "]";
  81         } else {
  82             push @output, "'$arg'";
  83         }
  84     }
  85     print STDOUT join " ", @output, "\n";
  86     return 0;
  87 }