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.in,v 1.1 2007/06/28 19:47:26 rjones Exp $
9 use POE qw(Component::IRC);
11 #----------------------------------------------------------------------
12 # Start of configuration.
14 my $nick = "xavierbot";
15 my $ircname = "Xavierbot"; # Printable name.
16 #my $server = "chat.freenode.net";
17 my $server = "devserv.devel.redhat.com";
20 my @channels = ("#ocaml");
22 # End of configuration.
23 #----------------------------------------------------------------------
25 my $irc = POE::Component::IRC->spawn (
30 ) or die "POE::Component::IRC->spawn failed: $!";
32 POE::Session->create (
34 main => [ qw(_default _start irc_001 irc_public) ],
36 heap => { irc => $irc },
39 POE::Wheel::Run->new (
40 Program => [ "@WRAPPER@" ],
41 StdoutEvent => 'stdout_event',
42 StderrEvent => 'stdout_event',
50 my ($kernel, $heap) = @_[KERNEL,HEAP];
52 my $irc_session = $heap->{irc}->session_id ();
53 $kernel->post ($irc_session => register => "all");
54 $kernel->post ($irc_session => connect => { });
61 my ($kernel, $sender) = @_[KERNEL,SENDER];
63 my $poco_object = $sender->get_heap ();
64 print "Connected to ", $poco_object->server_name (), "\n";
66 $kernel->post ($sender => join => $_ ) for @channels;
72 my ($kernel, $sender, $who, $where, $what) =
73 @_[KERNEL,SENDER,ARG0,ARG1,ARG2];
74 my $nick = (split /!/, $who)[0];
75 my $channel = $where->[0];
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");
87 my ($event, $args) = @_[ARG0 .. $#_];
88 my @output = ("$event: ");
90 foreach my $arg (@$args) {
91 if (ref ($arg) eq "ARRAY") {
92 push @output, "[" . join (" ,", @$arg) . "]";
94 push @output, "'$arg'";
97 print STDOUT join " ", @output, "\n";
101 #----------------------------------------------------------------------
107 my ($heap, $input, $wheel_id) = @_[HEAP,ARG0,ARG1];
108 print "Child said: $input\n";