package App::smsg::Command::Talk; use 5.010; use strict; use warnings; use utf8; BEGIN { $App::smsg::Command::Talk::AUTHORITY = 'https://dr.jones.dk/me#me'; $App::smsg::Command::Talk::VERSION = '0.001'; } use App::smsg -command; use namespace::clean; use AnyEvent; use AnyEvent::XMPP::Client; use AnyEvent::XMPP::Ext::Disco; use AnyEvent::XMPP::Ext::Version; use AnyEvent::XMPP::Ext::MUC; use AnyEvent::XMPP::Namespaces qw/xmpp_ns/; use AnyEvent::XMPP::Util qw/node_jid res_jid/; use constant abstract => q (Respond (stupidly simple) when addressed in a Jabber MUC.); use constant usage_desc => '%c talk %o []'; use constant description => <<'DESCRIPTION'; Connect to a Jabber MUC (a.k.a. chatroom) and emit a (silly) reply to each message posted which starts with bot name and a colon. DESCRIPTION use constant opt_spec => ( # [ 'verbose|v', "print extra stuff"], [ 'debug', "print debug stuff"], ); sub validate_args { my ($self, $opt, $args) = @_; $self->usage_error("too few arguments") unless @$args >= 3; } sub execute { my ($self, $opt, $args) = @_; my ($jid, $pw, $inputfile, $room) = @$args; 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"; read_messages ($inputfile); my $j = AnyEvent->condvar; my $cl = AnyEvent::XMPP::Client->new (debug => $opt->debug); my $disco = AnyEvent::XMPP::Ext::Disco->new; my $version = AnyEvent::XMPP::Ext::Version->new; my $muc = AnyEvent::XMPP::Ext::MUC->new (disco => $disco); $cl->add_extension ($disco); $cl->add_extension ($version); $cl->add_extension ($muc); $cl->set_presence (undef, 'I\'m a talking bot.', 1); $cl->add_account ($jid, $pw); warn "connecting to $jid...\n"; $cl->reg_cb ( session_ready => sub { my ($cl, $acc) = @_; $muc->join_room ($acc->connection, $room, node_jid ($acc->jid)); $muc->reg_cb ( message => sub { my ($cl, $room, $msg, $is_echo) = @_; return if $is_echo; return if $msg->is_delayed; my $mynick = res_jid ($room->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; } } ); }, 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; } 1;