my
$bot
= POE::Component::IRC->spawn(
Flood
=> 1,
plugin_debug
=> 1,
);
my
$ircd
= POE::Component::Server::IRC->spawn(
Auth
=> 0,
AntiFlood
=> 0,
);
$bot
->plugin_add(
CTCP
=> POE::Component::IRC::Plugin::CTCP->new(
version
=>
'Test version'
,
userinfo
=>
'Test userinfo'
,
clientinfo
=>
'Test clientinfo'
,
source
=>
'Test source'
,
));
POE::Session->create(
package_states
=> [
main
=> [
qw(
_start
ircd_listener_add
ircd_listener_failure
_shutdown
irc_001
irc_disconnected
irc_ctcpreply_version
irc_ctcpreply_userinfo
irc_ctcpreply_clientinfo
irc_ctcpreply_source
irc_ctcpreply_ping
irc_ctcpreply_time
)
],
],
);
$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
=>
'TestBot1'
,
server
=>
'127.0.0.1'
,
port
=>
$port
,
});
}
sub
irc_001 {
my
$irc
=
$_
[SENDER]->get_heap();
pass(
'Logged in'
);
$irc
->yield(
ctcp
=>
$irc
->nick_name(),
'VERSION'
);
$irc
->yield(
ctcp
=>
$irc
->nick_name(),
'USERINFO'
);
$irc
->yield(
ctcp
=>
$irc
->nick_name(),
'CLIENTINFO'
);
$irc
->yield(
ctcp
=>
$irc
->nick_name(),
'SOURCE'
);
$irc
->yield(
ctcp
=>
$irc
->nick_name(),
'PING test'
);
$irc
->yield(
ctcp
=>
$irc
->nick_name(),
'TIME'
);
}
sub
irc_ctcpreply_version {
my
(
$sender
,
$heap
,
$msg
) =
@_
[SENDER, HEAP, ARG2];
$heap
->{replies}++;
is(
$msg
,
'Test version'
,
'CTCP VERSION reply'
);
$sender
->get_heap()->yield(
'quit'
)
if
$heap
->{replies} == 6;
}
sub
irc_ctcpreply_userinfo {
my
(
$sender
,
$heap
,
$msg
) =
@_
[SENDER, HEAP, ARG2];
$heap
->{replies}++;
is(
$msg
,
'Test userinfo'
,
'CTCP USERINFO reply'
);
$sender
->get_heap()->yield(
'quit'
)
if
$heap
->{replies} == 6;
}
sub
irc_ctcpreply_clientinfo {
my
(
$sender
,
$heap
,
$msg
) =
@_
[SENDER, HEAP, ARG2];
$heap
->{replies}++;
is(
$msg
,
'Test clientinfo'
,
'CTCP CLIENTINFO reply'
);
$sender
->get_heap()->yield(
'quit'
)
if
$heap
->{replies} == 6;
}
sub
irc_ctcpreply_source {
my
(
$sender
,
$heap
,
$msg
) =
@_
[SENDER, HEAP, ARG2];
$heap
->{replies}++;
is(
$msg
,
'Test source'
,
'CTCP SOURCE reply'
);
$sender
->get_heap()->yield(
'quit'
)
if
$heap
->{replies} == 6;
}
sub
irc_ctcpreply_ping {
my
(
$sender
,
$heap
,
$msg
) =
@_
[SENDER, HEAP, ARG2];
$heap
->{replies}++;
is(
$msg
,
'test'
,
'CTCP PING reply'
);
$sender
->get_heap()->yield(
'quit'
)
if
$heap
->{replies} == 6;
}
sub
irc_ctcpreply_time {
my
(
$sender
,
$heap
,
$msg
) =
@_
[SENDER, HEAP, ARG2];
$heap
->{replies}++;
ok(
length
$msg
,
'CTCP TIME reply'
);
$sender
->get_heap()->yield(
'quit'
)
if
$heap
->{replies} == 6;
}
sub
irc_disconnected {
my
(
$kernel
,
$heap
) =
@_
[KERNEL, HEAP];
pass(
'irc_disconnected'
);
$kernel
->yield(
'_shutdown'
);
}
sub
_shutdown {
my
(
$kernel
,
$error
) =
@_
[KERNEL, ARG0];
fail(
$error
)
if
defined
$error
;
$kernel
->alarm_remove_all();
$ircd
->yield(
'shutdown'
);
$bot
->yield(
'shutdown'
);
}