summaryrefslogtreecommitdiff
path: root/smsbot
blob: 6cf59951ae87dcf00979a2032076e9355b3ea2e2 (plain)
  1. #!/usr/bin/perl
  2. use strict;
  3. use utf8;
  4. use AnyEvent;
  5. use AnyEvent::XMPP::Client;
  6. use AnyEvent::XMPP::Ext::Disco;
  7. use AnyEvent::XMPP::Ext::Version;
  8. use AnyEvent::XMPP::Ext::MUC;
  9. use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
  10. use AnyEvent::XMPP::Util qw/node_jid res_jid/;
  11. use NetSDS::Kannel;
  12. #use Coro;
  13. use Getopt::Long::Descriptive;
  14. my ($opt, $usage) = describe_options(
  15. '%c %o <jid> <password> <talkfile> [<room>]',
  16. ['kannelserver=s', "the Kannel server to connect to",
  17. {default => 'localhost'}],
  18. ['kannelport=i', "the Kannel port to connect to",
  19. {default => 13013}],
  20. ['kanneluser=s', "the Kannel users to authenticate as",
  21. {default => 'tester'}],
  22. ['kannelpasswd=s', "the Kannel password to authenticate with",
  23. {default => 'foobar'}],
  24. ['kannelsmsc=s', "the Kannel SMSC to correspond with"],
  25. [],
  26. # [ 'verbose|v', "print extra stuff"],
  27. [ 'debug', "print debug stuff"],
  28. [ 'help', "print usage message and exit"],
  29. );
  30. print($usage->text), exit if $opt->help;
  31. # TODO: support overriding full URL
  32. # TODO: use URI module to construct URL
  33. my $kannel = NetSDS::Kannel->new(
  34. sendsms_url => 'http://' . $opt->kannelserver . ':' . $opt->kannelport . '/cgi-bin/sendsms',
  35. sendsms_user => $opt->kanneluser,
  36. sendsms_passwd => $opt->kannelpasswd,
  37. default_smsc => $opt->kannelsmsc,
  38. );
  39. my @msgs;
  40. sub read_messages {
  41. my ($msgs_file) = @_;
  42. open my $f, $msgs_file
  43. or die "Couldn't open messages file: '$msgs_file'\n";
  44. (@msgs) = map { chomp; $_ } <$f>;
  45. close $f;
  46. }
  47. sub answer_to {
  48. my ($msg) = @_;
  49. my $talkmsg = $msgs[int (rand (@msgs))];
  50. "You said '$msg' but... " . $talkmsg;
  51. }
  52. binmode STDOUT, ":utf8";
  53. my ($jid, $pw, $inputfile, $room) = @ARGV;
  54. unless (@ARGV >= 3) {
  55. warn "usage: talkbot <jid> <password> <talkfile> [<conference room jid>]\n";
  56. exit;
  57. }
  58. read_messages ($inputfile);
  59. my $j = AnyEvent->condvar;
  60. my $cl = AnyEvent::XMPP::Client->new (debug => $opt->debug);
  61. my $disco = AnyEvent::XMPP::Ext::Disco->new;
  62. my $version = AnyEvent::XMPP::Ext::Version->new;
  63. my $muc = AnyEvent::XMPP::Ext::MUC->new (disco => $disco);
  64. $cl->add_extension ($disco);
  65. $cl->add_extension ($version);
  66. $cl->add_extension ($muc);
  67. $cl->set_presence (undef, 'I\'m a talking bot.', 1);
  68. $cl->add_account ($jid, $pw);
  69. warn "connecting to $jid...\n";
  70. $cl->reg_cb (
  71. session_ready => sub {
  72. my ($cl, $acc) = @_;
  73. $muc->join_room ($acc->connection, $room, node_jid ($acc->jid));
  74. $muc->reg_cb (
  75. message => sub {
  76. my ($cl, $room, $msg, $is_echo) = @_;
  77. return if $is_echo;
  78. return if $msg->is_delayed;
  79. my $mynick = res_jid ($room->nick_jid);
  80. if ($msg->any_body =~ /^\s*\Q$mynick\E:\s+(.*?)\s*$/) {
  81. my $ans = answer_to ($1);
  82. my $repl = $msg->make_reply;
  83. $repl->add_body ($ans);
  84. $repl->send;
  85. }
  86. }
  87. );
  88. },
  89. message => sub {
  90. my ($cl, $acc, $msg) = @_;
  91. my $talkmsg = $msgs[int (rand (@msgs))];
  92. my $repl = $msg->make_reply;
  93. $repl->add_body (answer_to ($msg->any_body));
  94. warn "Got message: '".$msg->any_body."' from ".$msg->from."\n";
  95. warn "Answered: $talkmsg\n";
  96. $repl->send;
  97. },
  98. contact_request_subscribe => sub {
  99. my ($cl, $acc, $roster, $contact) = @_;
  100. $contact->send_subscribed;
  101. warn "Subscribed to ".$contact->jid."\n";
  102. },
  103. error => sub {
  104. my ($cl, $acc, $error) = @_;
  105. warn "Error encountered: ".$error->string."\n";
  106. $j->broadcast;
  107. },
  108. disconnect => sub {
  109. warn "Got disconnected: [@_]\n";
  110. $j->broadcast;
  111. },
  112. );
  113. $cl->start;
  114. $j->wait;
  115. __END__
  116. =head1 COPYRIGHT
  117. 2012 © Jonas Smedegaard <dr@jones.dk>
  118. =head1 BUGS
  119. Send Bug Reports to Jonas Smedegaard <dr@jones.dk>