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