xavierbot.pl

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