package App::smsg::Command::Talk; use strict; use utf8; use App::smsg -command; 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 NetSDS::Kannel; #use Coro; sub abstract { 'respond (stupidly simple) when addressed in a Jabber MUC' } sub usage_desc { '%c talk %o []' } sub opt_spec { return ( ['kannelserver=s', "the Kannel server to connect to", {default => 'localhost'}], ['kannelport=i', "the Kannel port to connect to", {default => 13013}], ['kanneluser=s', "the Kannel users to authenticate as", {default => 'tester'}], ['kannelpasswd=s', "the Kannel password to authenticate with", {default => 'foobar'}], ['kannelsmsc=s', "the Kannel SMSC to correspond with"], [], # [ '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; # TODO: support overriding full URL # TODO: use URI module to construct URL my $kannel = NetSDS::Kannel->new( sendsms_url => 'http://' . $opt->kannelserver . ':' . $opt->kannelport . '/cgi-bin/sendsms', sendsms_user => $opt->kanneluser, sendsms_passwd => $opt->kannelpasswd, default_smsc => $opt->kannelsmsc, ); 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; __END__ =head1 COPYRIGHT 2012 © Jonas Smedegaard =head1 BUGS Send Bug Reports to Jonas Smedegaard