The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

use strict;
use warnings FATAL => 'all';
use lib 't/inc';
use POE;
use POE::Component::IRC::Common qw(parse_user);
use Test::More 'no_plan';
my $bot = POE::Component::IRC::State->spawn(Flood => 1);
my $ircd = POE::Component::Server::IRC->spawn(
Auth => 0,
AntiFlood => 0,
);
isa_ok($bot, 'POE::Component::IRC::State');
POE::Session->create(
package_states => [
main => [qw(
_start
ircd_listener_add
ircd_listener_failure
_shutdown
irc_registered
irc_connected
irc_001
irc_221
irc_305
irc_306
irc_whois
irc_join
irc_topic
irc_chan_sync
irc_user_mode
irc_chan_mode
irc_mode
irc_error
irc_disconnected
)],
],
);
$poe_kernel->run();
sub _start {
my ($kernel) = $_[KERNEL];
$ircd->yield('register', 'all');
$ircd->yield('add_listener');
$kernel->delay(_shutdown => 60, 'Timed out');
}
sub ircd_listener_failure {
my ($kernel, $op, $reason) = @_[KERNEL, ARG1, ARG3];
$kernel->yield('_shutdown', "$op: $reason");
}
sub ircd_listener_add {
my ($kernel, $port) = @_[KERNEL, ARG0];
$bot->yield(register => 'all');
$bot->yield(connect => {
nick => 'TestBot',
server => '127.0.0.1',
port => $port,
ircname => 'Test test bot',
});
}
sub _shutdown {
my ($kernel, $error) = @_[KERNEL, ARG0];
fail($error) if defined $error;
$kernel->alarm_remove_all();
$ircd->yield('shutdown');
$bot->yield('shutdown');
}
sub irc_registered {
my ($irc) = $_[ARG0];
isa_ok($irc, 'POE::Component::IRC::State');
}
sub irc_connected {
pass('Connected');
}
sub irc_001 {
my ($heap, $server) = @_[HEAP, ARG0];
my $irc = $_[SENDER]->get_heap();
$heap->{server} = $server;
pass('Logged in');
is($irc->server_name(), 'poco.server.irc', 'Server Name Test');
is($irc->nick_name(), 'TestBot', 'Nick Name Test');
ok(!$irc->is_operator($irc->nick_name()), 'We are not an IRC op');
ok(!$irc->is_away($irc->nick_name()), 'We are not away');
$irc->yield(away => 'Gone for now');
$irc->yield(whois => 'TestBot');
}
sub irc_305 {
my $irc = $_[SENDER]->get_heap();
ok(!$irc->is_away($irc->nick_name()), 'We are back');
}
sub irc_306 {
my $irc = $_[SENDER]->get_heap();
ok($irc->is_away($irc->nick_name()), 'We are away now');
$irc->yield('away');
}
sub irc_whois {
my ($sender, $whois) = @_[SENDER, ARG0];
is($whois->{nick}, 'TestBot', 'Whois hash test');
$sender->get_heap()->yield(join => '#testchannel');
}
sub irc_join {
my ($sender, $who, $where) = @_[SENDER, ARG0, ARG1];
my $nick = parse_user($who);
my $irc = $sender->get_heap();
is($nick, $irc->nick_name(), 'JOINER Test');
is($where, '#testchannel', 'Joined Channel Test');
is($who, $irc->nick_long_form($nick), 'nick_long_form()');
my $chans = $irc->channels();
is(keys %$chans, 1, 'Correct number of channels');
is((keys %$chans)[0], $where, 'Correct channel name');
my @nicks = $irc->nicks();
is(@nicks, 1, 'Only one nick known');
is($nicks[0], $nick, 'Nickname correct');
$irc->yield(topic => $where, 'Test topic');
}
sub irc_topic {
my ($sender, $heap, $chan, $topic) = @_[SENDER, HEAP, ARG1, ARG2];
my $irc = $sender->get_heap();
$heap->{got_topic}++;
if ($heap->{got_topic} == 1) {
my $topic_info = $irc->channel_topic($chan);
is($topic, $topic_info->{Value}, 'Channel topic set');
$heap->{topic} = $topic_info;
$irc->yield(topic => $chan, 'New test topic');
}
elsif ($heap->{got_topic} == 2) {
my $old_topic = $_[ARG3];
is_deeply($old_topic, $heap->{topic}, 'Got old topic');
}
}
sub irc_chan_sync {
my ($sender, $heap, $chan) = @_[SENDER, HEAP, ARG0];
my $irc = $sender->get_heap();
my ($nick, $user, $host) = parse_user($irc->nick_long_form($irc->nick_name()));
my ($occupant) = $irc->channel_list($chan);
is($occupant, 'TestBot', 'Channel Occupancy Test');
ok($irc->channel_creation_time($chan), 'Got channel creation time');
ok(!$irc->channel_limit($chan), 'There is no channel limit');
ok(!$irc->is_channel_mode_set($chan, 'i'), 'Channel mode i not set yet');
ok($irc->is_channel_member($chan, $nick), 'Is Channel Member');
ok($irc->is_channel_operator($chan, $nick), 'Is Channel Operator');
ok(!$irc->is_channel_halfop($chan, $nick), 'Is not channel halfop');
ok(!$irc->has_channel_voice($chan, $nick), 'Does not have channel voice');
ok($irc->ban_mask($chan, $nick), 'Ban Mask Test');
my @channels = $irc->nick_channels($nick);
is(@channels, 1, 'Only present in one channel');
is($channels[0], $chan, 'The channel name matches');
my $info = $irc->nick_info($nick);
is($info->{Nick}, $nick, 'nick_info() - Nick');
is($info->{User}, $user, 'nick_info() - User');
is($info->{Host}, $host, 'nick_info() - Host');
is($info->{Userhost}, "$user\@$host", 'nick_info() - Userhost');
is($info->{Hops}, 0, 'nick_info() - Hops');
is($info->{Real}, 'Test test bot', 'nick_info() - Realname');
is($info->{Server}, $heap->{server}, 'nick_info() - Server');
ok(!$info->{IRCop}, 'nick_info() - IRCop');
$irc->yield(mode => $chan, '+l 100');
$heap->{mode_changed} = 1;
}
sub irc_chan_mode {
my ($sender, $heap, $who, $chan, $mode) = @_[SENDER, HEAP, ARG0..ARG2];
my $irc = $sender->get_heap();
return if !$heap->{mode_changed};
$mode =~ s/\+//g;
ok($irc->is_channel_mode_set($chan, $mode), "Channel Mode Set: $mode");
is($irc->channel_limit($chan), 100, 'Channel limit correct');
$irc->yield('quit');
}
sub irc_user_mode {
my ($sender, $who, $mode) = @_[SENDER, ARG0, ARG2];
my $irc = $sender->get_heap();
$mode =~ s/\+//g;
ok($irc->is_user_mode_set($mode), "User Mode Set: $mode");
like($irc->umode(), qr/$mode/, 'Correct user mode in state');
}
sub irc_mode {
my $irc = $_[SENDER]->get_heap();
return if $_[ARG1] !~ /^\#/;
}
sub irc_221 {
my $irc = $_[SENDER]->get_heap();
pass('State did a MODE query');
$irc->yield(mode => $irc->nick_name(), '+iw');
}
sub irc_error {
pass('irc_error');
}
sub irc_disconnected {
pass('irc_disconnected');
$poe_kernel->yield('_shutdown');
}