my
$log_dir
= tempdir(
CLEANUP
=> 1);
my
$bot1
= POE::Component::IRC::State->spawn(
Flood
=> 1,
plugin_debug
=> 1,
);
my
$bot2
= POE::Component::IRC::State->spawn(
Flood
=> 1,
plugin_debug
=> 1,
);
my
$ircd
= POE::Component::Server::IRC->spawn(
Auth
=> 0,
AntiFlood
=> 0,
);
$bot2
->plugin_add(
Logger
=> POE::Component::IRC::Plugin::Logger->new(
Path
=>
$log_dir
,
Notices
=> 1,
));
my
$file
= catfile(
$log_dir
,
'#testchannel.log'
);
my
@correct
= (
qr/^--> TestBot2 \(\S+@\S+\) joins #testchannel$/
,
'<TestBot1> Oh hi'
,
'>TestBot1< Hello'
,
'--- TestBot1 disables topic protection'
,
'--- TestBot1 enables secret channel status'
,
'--- TestBot1 enables channel moderation'
,
'--- TestBot1 sets channel keyword to foo'
,
'--- TestBot1 removes channel keyword'
,
'--- TestBot1 sets channel user limit to 10'
,
'--- TestBot1 removes channel user limit'
,
'--- TestBot1 sets ban on TestBot2!*@*'
,
'--- TestBot1 removes ban on TestBot2!*@*'
,
'--- TestBot1 gives channel operator status to TestBot2'
,
'--- TestBot1 changes the topic to: Testing, 1 2 3'
,
'--- TestBot1 is now known as NewNick'
,
qr/^<-- NewNick \(\S+@\S+\) leaves #testchannel \(NewNick\)$/
,
qr/^--> NewNick \(\S+@\S+\) joins #testchannel$/
,
'<-- TestBot2 kicks NewNick from #testchannel (Bye bye)'
,
qr/^--> NewNick \(\S+@\S+\) joins #testchannel$/
,
qr/^<-- NewNick \(\S+@\S+\) quits \(.*\)$/
,
);
plan
tests
=> 10 +
@correct
;
POE::Session->create(
package_states
=> [
main
=> [
qw(
_start
ircd_listener_add
ircd_listener_failure
_shutdown
irc_001
irc_join
irc_part
irc_kick
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];
$bot1
->yield(
register
=>
'all'
);
$bot1
->yield(
connect
=> {
nick
=>
'TestBot1'
,
server
=>
'127.0.0.1'
,
port
=>
$port
,
});
$bot2
->yield(
register
=>
'all'
);
$bot2
->yield(
connect
=> {
nick
=>
'TestBot2'
,
server
=>
'127.0.0.1'
,
port
=>
$port
,
});
}
sub
_shutdown {
my
(
$kernel
,
$error
) =
@_
[KERNEL, ARG0];
fail(
$error
)
if
defined
$error
;
$kernel
->alarm_remove_all();
$ircd
->yield(
'shutdown'
);
$bot1
->yield(
'shutdown'
);
$bot2
->yield(
'shutdown'
);
}
sub
irc_001 {
my
(
$heap
,
$server
) =
@_
[HEAP, ARG0];
my
$irc
=
$_
[SENDER]->get_heap();
pass(
$irc
->nick_name() .
' logged in'
);
$heap
->{logged_in}++;
if
(
$heap
->{logged_in} == 2) {
$bot1
->yield(
join
=>
'#testchannel'
);
}
}
sub
irc_join {
my
(
$sender
,
$heap
,
$who
,
$where
) =
@_
[SENDER, HEAP, ARG0, ARG1];
my
$nick
= (
split
/!/,
$who
)[0];
my
$irc
=
$sender
->get_heap();
return
if
$nick
ne
$irc
->nick_name();
pass(
"$nick joined channel"
);
$heap
->{joined}++;
if
(
$heap
->{joined} == 1) {
$bot2
->yield(
join
=>
$where
);
return
;
}
if
(
$heap
->{done}) {
$bot1
->yield(
'quit'
);
return
;
}
if
(
$irc
==
$bot2
) {
$bot1
->yield(
privmsg
=>
$where
,
'Oh hi'
);
$bot1
->yield(
notice
=>
$where
,
'Hello'
);
$bot1
->yield(
mode
=>
$where
,
'-t'
);
$bot1
->yield(
mode
=>
$where
,
'+s'
);
$bot1
->yield(
mode
=>
$where
,
'+m'
);
$bot1
->yield(
mode
=>
$where
,
'+k foo'
);
$bot1
->yield(
mode
=>
$where
,
'-k'
);
$bot1
->yield(
mode
=>
$where
,
'+l 10'
);
$bot1
->yield(
mode
=>
$where
,
'-l'
);
$bot1
->yield(
mode
=>
$where
,
'+b TestBot2!*@*'
);
$bot1
->yield(
mode
=>
$where
,
'-b TestBot2!*@*'
);
$bot1
->yield(
mode
=>
$where
,
'+o TestBot2'
);
$bot1
->yield(
topic
=>
$where
,
'Testing, 1 2 3'
);
$bot1
->yield(
nick
=>
'NewNick'
);
$bot1
->yield(
part
=>
$where
);
}
else
{
$bot2
->yield(
kick
=>
$where
,
$bot1
->nick_name(),
'Bye bye'
);
}
}
sub
irc_part {
my
$irc
=
$_
[SENDER]->get_heap();
my
$nick
= (
split
/!/,
$_
[ARG0])[0];
if
(
$nick
eq
$irc
->nick_name()) {
pass(
"$nick parted channel"
);
$irc
->yield(
join
=>
$_
[ARG1]);
}
}
sub
irc_kick {
my
(
$heap
,
$chan
,
$nick
) =
@_
[HEAP, ARG1, ARG2];
my
$irc
=
$_
[SENDER]->get_heap();
return
if
$nick
ne
$irc
->nick_name();
pass(
$nick
.
' kicked'
);
$irc
->yield(
join
=>
$chan
);
$heap
->{done} = 1;
}
sub
irc_disconnected {
my
(
$kernel
,
$sender
) =
@_
[KERNEL, SENDER];
my
$irc
=
$sender
->get_heap();
pass(
'irc_disconnected'
);
if
(
$irc
==
$bot1
) {
$bot2
->yield(
'quit'
);
}
else
{
verify_log();
$kernel
->yield(
'_shutdown'
);
}
}
sub
verify_log {
open
my
$log
,
'<'
,
$file
or
die
"Can't open log file '$file': $!"
;
my
@lines
= <
$log
>;
close
$log
;
my
$check
= 0;
for
my
$line
(
@lines
) {
next
if
$line
=~ /^\*{3}/;
chomp
$line
;
$line
=
substr
(
$line
, 20);
last
if
!
defined
$correct
[
$check
];
if
(
ref
$correct
[
$check
] eq
'Regexp'
) {
like(
$line
,
$correct
[
$check
],
'Line '
. (
$check
+1));
}
else
{
is(
$line
,
$correct
[
$check
],
'Line '
. (
$check
+1));
}
$check
++;
}
fail(
'Log too short'
)
if
$check
>
@correct
;
}