#!/opt/perl/bin/perl
my
@msgs
;
sub
read_messages {
my
(
$msgs_file
) =
@_
;
open
my
$f
,
$msgs_file
or
die
"Couldn't open messages file: '$msgs_file'\n"
;
(
@msgs
) =
map
{
chomp
;
$_
} <
$f
>;
close
$f
;
}
sub
answer_to {
my
(
$msg
) =
@_
;
my
$talkmsg
=
$msgs
[
int
(
rand
(
@msgs
))];
"You said '$msg' but... "
.
$talkmsg
;
}
binmode
STDOUT,
":utf8"
;
my
(
$jid
,
$pw
,
$inputfile
,
$room
) =
@ARGV
;
unless
(
@ARGV
>= 3) {
warn
"usage: talkbot <jid> <password> <talkfile> [<conference room jid>]\n"
;
exit
;
}
read_messages (
$inputfile
);
my
$j
= AnyEvent->condvar;
my
$cl
= Net::XMPP2::Client->new (
debug
=> 1);
my
$disco
= Net::XMPP2::Ext::Disco->new;
my
$version
= Net::XMPP2::Ext::Version->new;
$cl
->add_extension (
$disco
);
$cl
->add_extension (
$version
);
$cl
->set_presence (
undef
,
'I\'m a talking bot.'
, 1);
$cl
->add_account (
$jid
,
$pw
);
my
$muc
;
my
$roomhdl
;
warn
"connecting to $jid...\n"
;
$cl
->reg_cb (
session_ready
=>
sub
{
my
(
$cl
,
$acc
) =
@_
;
my
$con
=
$acc
->connection;
$muc
= Net::XMPP2::Ext::MUC->new (
disco
=>
$disco
,
connection
=>
$con
);
$con
->add_extension (
$muc
);
$muc
->join_room (
$room
, node_jid (
$acc
->jid),
sub
{
my
(
$rhdl
,
$me
,
$err
) =
@_
;
if
(
$err
) {
warn
"Couldn't join $room: "
.
$err
->string .
"\n"
;
}
else
{
$roomhdl
=
$rhdl
;
$rhdl
->reg_cb (
message
=>
sub
{
my
(
$rhdl
,
$msg
,
$is_echo
) =
@_
;
return
if
$is_echo
;
return
if
$msg
->is_delayed;
my
$mynick
= res_jid (
$rhdl
->nick_jid);
if
(
$msg
->any_body =~ /^\s*\Q
$mynick
\E:\s+(.*?)\s*$/) {
my
$ans
= answer_to ($1);
my
$repl
=
$msg
->make_reply;
$repl
->add_body (
$ans
);
$repl
->
send
;
}
}
);
}
});
warn
"connected!\n"
;
},
message
=>
sub
{
my
(
$cl
,
$acc
,
$msg
) =
@_
;
my
$talkmsg
=
$msgs
[
int
(
rand
(
@msgs
))];
my
$repl
=
$msg
->make_reply;
$repl
->add_body (answer_to (
$msg
->any_body));
warn
"Got message: '"
.
$msg
->any_body.
"' from "
.
$msg
->from.
"\n"
;
warn
"Answered: $talkmsg\n"
;
$repl
->
send
;
},
contact_request_subscribe
=>
sub
{
my
(
$cl
,
$acc
,
$roster
,
$contact
) =
@_
;
$contact
->send_subscribed;
warn
"Subscribed to "
.
$contact
->jid.
"\n"
;
},
error
=>
sub
{
my
(
$cl
,
$acc
,
$error
) =
@_
;
warn
"Error encountered: "
.
$error
->string.
"\n"
;
$j
->broadcast;
},
disconnect
=>
sub
{
warn
"Got disconnected: [@_]\n"
;
$j
->broadcast;
},
);
$cl
->start;
$j
->
wait
;