#!/usr/bin/perl -wT # xavierbot : an OCaml interpreter IRC bot. # By Richard W.M. Jones . # This code is in the Public Domain. # $Id: xavierbot.pl.in,v 1.1 2007/06/28 19:47:26 rjones Exp $ use strict; use POE qw(Component::IRC); #---------------------------------------------------------------------- # Start of configuration. my $nick = "xavierbot"; my $ircname = "Xavierbot"; # Printable name. #my $server = "chat.freenode.net"; my $server = "devserv.devel.redhat.com"; my $port = 6667; my @channels = ("#ocaml"); # End of configuration. #---------------------------------------------------------------------- my $irc = POE::Component::IRC->spawn ( nick => $nick, ircname => $ircname, server => $server, port => $port, ) or die "POE::Component::IRC->spawn failed: $!"; POE::Session->create ( package_states => [ main => [ qw(_default _start irc_001 irc_public) ], ], heap => { irc => $irc }, ); POE::Wheel::Run->new ( Program => [ "@WRAPPER@" ], StdoutEvent => 'stdout_event', StderrEvent => 'stdout_event', ); POE::Kernel->run (); exit 0; sub _start { my ($kernel, $heap) = @_[KERNEL,HEAP]; my $irc_session = $heap->{irc}->session_id (); $kernel->post ($irc_session => register => "all"); $kernel->post ($irc_session => connect => { }); undef; } sub irc_001 { my ($kernel, $sender) = @_[KERNEL,SENDER]; my $poco_object = $sender->get_heap (); print "Connected to ", $poco_object->server_name (), "\n"; $kernel->post ($sender => join => $_ ) for @channels; undef; } sub irc_public { my ($kernel, $sender, $who, $where, $what) = @_[KERNEL,SENDER,ARG0,ARG1,ARG2]; my $nick = (split /!/, $who)[0]; my $channel = $where->[0]; print "got: $what\n"; if (my ($rot13) = $what =~ /^rot13 (.+)/) { $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M]; $kernel->post ($sender => privmsg => $channel => "$nick: $rot13"); } undef; } sub _default { my ($event, $args) = @_[ARG0 .. $#_]; my @output = ("$event: "); foreach my $arg (@$args) { if (ref ($arg) eq "ARRAY") { push @output, "[" . join (" ,", @$arg) . "]"; } else { push @output, "'$arg'"; } } print STDOUT join " ", @output, "\n"; return 0; } #---------------------------------------------------------------------- # Start the bot. sub stdout_event { my ($heap, $input, $wheel_id) = @_[HEAP,ARG0,ARG1]; print "Child said: $input\n"; }