#!/usr/bin/perl use strict; use utf8; 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; use Getopt::Long::Descriptive; my ($opt, $usage) = describe_options( '%c %o []', ['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"], [ 'help', "print usage message and exit"], ); print($usage->text), exit if $opt->help; # 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"; my ($jid, $pw, $inputfile, $room) = @ARGV; unless (@ARGV >= 3) { warn "usage: talkbot []\n"; exit; } 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; __END__ =head1 COPYRIGHT 2012 © Jonas Smedegaard =head1 BUGS Send Bug Reports to Jonas Smedegaard