| POE-Component-IRC-Plugin-POE-Knee documentation | Contained in the POE-Component-IRC-Plugin-POE-Knee distribution. |
POE::Component::IRC::Plugin::POE::Knee - A POE::Component::IRC plugin that runs Acme::POE::Knee races.
use strict;
use warnings;
use POE qw(Component::IRC::State Component::IRC::Plugin::POE::Knee);
my $nickname = 'PoeKnee' . $$;
my $ircname = 'PoeKnee the Sailor Bot';
my $ircserver = 'irc.blah.org';
my $port = 6667;
my $channel = '#IRC.pm';
my $irc = POE::Component::IRC::State->spawn(
nick => $nickname,
server => $ircserver,
port => $port,
ircname => $ircname,
debug => 0,
plugin_debug => 1,
options => { trace => 0 },
) or die "Oh noooo! $!";
POE::Session->create(
package_states => [
'main' => [ qw(_start irc_001 irc_poeknee_results) ],
],
);
$poe_kernel->run();
exit 0;
sub _start {
# Create and load our CTCP plugin
$irc->plugin_add( 'PoeKnee' =>
POE::Component::IRC::Plugin::POE::Knee->new( stages => 8 ) );
$irc->yield( register => 'all' );
$irc->yield( connect => { } );
undef;
}
sub irc_001 {
$irc->yield( join => $channel );
undef;
}
sub irc_poeknee_results {
my ($channel,$results) = @_[ARG0,ARG1];
print "$channel\n";
print "$_\n" for @{ $results };
undef;
}
POE::Component::IRC::Plugin::POE::Knee, is a POE::Component::IRC plugin that runs Acme::POE::Knee style horse races on IRC channels using the channel member list to generate the POE::Knees. >:)
newCreates a new plugin object. You may specify the following optional parameters:
'stages' => the number of stages involved in the race, default is 5;
POEKNEEIf your bot is addressed by name with the command 'POEKNEE' (case doesn't matter), with optional number of stages, a POE::Knee race is started.
GumbyBRAIN: POEKNEE 10
Apart from the output seen on the IRC channel where a POE::Knee race is currently underway, at the end of a race the following 'irc' event is generated.
irc_poeknee_resultsGenerated each time a POE::Knee race finishes.
ARG0, the channel where the race was run; ARG1, an arrayref containing lots of potentially uninteresting data;
Chris 'BinGOs' Williams
Based on Acme::POE::Knee by Jos Boumans and Rocco Caputo
Copyright © Chris Williams, Jos Boumans and Rocco Caputo.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| POE-Component-IRC-Plugin-POE-Knee documentation | Contained in the POE-Component-IRC-Plugin-POE-Knee distribution. |
package POE::Component::IRC::Plugin::POE::Knee; use strict; use warnings; use Time::HiRes qw(gettimeofday); use Math::Random; use POE; use POE::Component::IRC::Plugin qw(:ALL); use POE::Component::IRC::Common qw(:ALL); use vars qw($VERSION); $VERSION = '1.08'; sub new { my $package = shift; my %args = @_; $args{lc $_} = delete $args{$_} for keys %args; $args{stages} = 5 unless $args{stages} and $args{stages} =~ /^\d+$/ and $args{stages} <= 30; bless \%args, $package; } sub PCI_register { my ($self,$irc) = @_; die "This plugin must be used with POE::Component::IRC::State or a subclass of that\n" unless $irc->isa('POE::Component::IRC::State'); $self->{irc} = $irc; $irc->plugin_register( $self, 'SERVER', qw(public) ); $self->{session_id} = POE::Session->create( object_states => [ $self => [ qw(_shutdown _start _race_on _run) ], ], )->ID(); return 1; } sub PCI_unregister { my ($self,$irc) = splice @_, 0, 2; $poe_kernel->call( $self->{session_id} => '_shutdown' ); delete $self->{irc}; return 1; } sub S_public { my ($self,$irc) = splice @_, 0, 2; my ($nick,$userhost) = ( split /!/, ${ $_[0] } )[0..1]; my $channel = ${ $_[1] }->[0]; my $what = ${ $_[2] }; my $mapping = $irc->isupport('CASEMAPPING'); my $mynick = $irc->nick_name(); my ($command) = $what =~ m/^\s*\Q$mynick\E[\:\,\;\.]?\s*(.*)$/i; return PCI_EAT_NONE unless $command; my @cmd = split /\s+/, $command; return PCI_EAT_NONE unless uc( $cmd[0] ) eq 'POEKNEE'; if ( $self->{_race_in_progress} ) { $irc->yield( privmsg => $channel => "There is already a race in progress" ); return PCI_EAT_NONE; } $poe_kernel->post( $self->{session_id}, '_race_on', $channel, $cmd[1] ); return PCI_EAT_NONE; } sub _start { my ($kernel,$self) = @_[KERNEL,OBJECT]; $self->{_race_in_progress} = 0; $self->{session_id} = $_[SESSION]->ID(); $kernel->refcount_increment( $self->{session_id}, __PACKAGE__ ); undef; } sub _shutdown { my ($kernel,$self) = @_[KERNEL,OBJECT]; $kernel->alarm_remove_all(); $kernel->refcount_decrement( $self->{session_id}, __PACKAGE__ ); undef; } sub _race_on { my ($kernel,$self,$channel,$stages) = @_[KERNEL,OBJECT,ARG0,ARG1]; $stages = $self->{stages} unless $stages and $stages =~ /^\d+$/ and $stages <= 30; $self->{_race_in_progress} = 1; $self->{_distance} = $stages; $self->{_progress} = [ ]; my $irc = $self->{irc}; my @channel_list = $irc->channel_list($channel); my $seed = 5; my $start = 'POE::Knee Race is on! ' . scalar @channel_list . ' ponies over ' . $self->{_distance} . ' stages.'; push @{ $self->{_progress} }, join(' ', _stamp(), $start); $irc->yield('ctcp', $channel, 'ACTION ' . $start ); foreach my $nick ( @channel_list ) { #my $nick_modes = $irc->nick_channel_modes($channel,$nick); #$seed += rand(3) if $nick_modes =~ /o/; #$seed += rand(2) if $nick_modes =~ /h/; #$seed += rand(1) if $nick_modes =~ /v/; my $delay = random_uniform(1,0,$seed); push @{ $self->{_progress} }, join(' ', _stamp(), $nick, "($delay)", "is off!"); $kernel->delay_add( '_run', $delay, $nick, $channel, $seed, 1 ); } undef; } sub _run { my ($kernel,$self,$nick,$channel,$seed,$stage) = @_[KERNEL,OBJECT,ARG0..ARG3]; push @{ $self->{_progress} }, _stamp() . " $nick reached stage " . ++$stage; if ( $stage > $self->{_distance} ) { # Stop the race $kernel->alarm_remove_all(); my $result = "$nick! Won the POE::Knee race!"; $self->{irc}->yield( 'privmsg', $channel, $result ); push @{ $self->{_progress} }, _stamp() . " " . $result; my $race_result = delete $self->{_progress}; $self->{irc}->yield( '__send_event', 'irc_poeknee_results', $channel, $race_result ); $self->{_race_in_progress} = 0; return; } if ( $stage > $self->{_race_in_progress} ) { $self->{irc}->yield( 'ctcp', $channel, "ACTION $nick! leads at stage $stage" ); $self->{_race_in_progress}++; } $kernel->delay_add( '_run', random_uniform(1,0,$seed), $nick, $channel, $seed, $stage ); undef; } sub _stamp { return join('.', gettimeofday); } 1; __END__