bot

• package main
  • _start
  • irc_001
  • irc_public
  • irc_msg
  • _default
• EOF

#!/sw/bin/perl -w

use strict;
use warnings;
use POE qw(
    Component::IRC
);
use Bot;

my $mynick = 'poebot',
my $channel = '#poebrum';
my $server = "irc.xs4all.nl";

my $irc = POE::Component::IRC->spawn(
    nick => $mynick,
    server => $server,
    port => 6667,
    ircname => "YAPC-EU demo-bot",
)
    or die "irc: $!\n";

POE::Session->create(
    package_states => [
        main => [ qw(_start _default irc_001 irc_public irc_msg) ],
    ],
    heap => {
        Irc => $irc,
        Channel => $channel,
    },
);

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 => {} );
    return;
}

sub irc_001 {
    my($kernel, $heap, $session, @args) =
	@_[KERNEL, HEAP, SESSION, ARG0 .. $#_];
    ### we're connected, make sure we join the channel
    $irc->yield( join => $channel );
    ### print stuff on debug
    $kernel->call( $session, _default => 'irc_001', \@args );
    $heap->{Bot} = Bot->new($kernel, $heap);
    return;
}

sub irc_public {
    my($kernel, $heap, $who, $where, $what) =
        @_[KERNEL, HEAP, ARG0, ARG1, ARG2];
    my $nick = ( split /!/, $who )[0];
    my $channel = $where->[0];

    print "$channel <$nick> $what\n";
    if ( $what =~ /^\s*\Q$mynick\E\b[:,;.-]?\s*(.*)$/i ) {
        my $bot = $heap->{Bot};
	$bot->handle($channel, "$nick: ", $1);
    }
    return;
}

sub irc_msg {
    my($kernel, $heap, $who, $what) = @_[KERNEL, HEAP, ARG0, ARG2];
    my $nick = ( split /!/, $who )[0];

    print "$nick whispers: $what\n";
    my $bot = $heap->{Bot};
    $bot->handle($nick, "", $what);
    return;
}

sub _default {
    my($event, $args) = @_[ARG0, ARG1];
    my(@output) = ( "$event: " );
    for my $arg ( @$args ) {
        if ( ref($arg) eq 'ARRAY' ) {
            push @output, "[" . join(", ", @$arg) . "]";
        } else {
            push @output, "'$arg'";
        }
    }
    print "@output\n";
    return;
}