The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package POE::Component::IRC::Plugin::POE::Knee;
$POE::Component::IRC::Plugin::POE::Knee::VERSION = '1.10';
#ABSTRACT: A POE::Component::IRC plugin that runs Acme::POE::Knee races.

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);

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);
}

qq[Ride the ponies];

__END__

=pod

=encoding UTF-8

=head1 NAME

POE::Component::IRC::Plugin::POE::Knee - A POE::Component::IRC plugin that runs Acme::POE::Knee races.

=head1 VERSION

version 1.10

=head1 SYNOPSIS

  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;
  }

=head1 DESCRIPTION

POE::Component::IRC::Plugin::POE::Knee, is a L<POE::Component::IRC> plugin that runs L<Acme::POE::Knee> style
horse races on IRC channels using the channel member list to generate the POE::Knees. >:)

=for Pod::Coverage PCI_register PCI_unregister S_public

=head1 CONSTRUCTOR

=over

=item C<new>

Creates a new plugin object. You may specify the following optional parameters:

  'stages' => the number of stages involved in the race, default is 5;

=back

=head1 IRC INPUT

=over

=item C<POEKNEE>

If 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

=back

=head1 OUTPUT

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.

=over

=item C<irc_poeknee_results>

Generated each time a POE::Knee race finishes.

  ARG0, the channel where the race was run;
  ARG1, an arrayref containing lots of potentially uninteresting data;

=back

=head1 SEE ALSO

L<POE::Component::IRC>

L<Acme::POE::Knee>

=head1 AUTHORS

=over 4

=item *

Chris Williams

=item *

Jos Boumans

=item *

Rocco Caputo

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017 by Chris Williams.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut