scripts/mqr-xmpp-client.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4 use utf8;
   5 use AnyEvent;
   6 use AnyEvent::XMPP::Client;
   7 use AnyEvent::XMPP::Ext::Disco;
   8 use AnyEvent::XMPP::Ext::Version;
   9 use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
  10 use AnyEvent::Redis;
  11
  12 my @msgs;
  13
  14 sub read_messages {
  15    my ($msgs_file) = @_;
  16    open my $f, $msgs_file
  17       or die "Couldn't open messages file: '$msgs_file'\n";
  18    (@msgs) = map { chomp; $_ } <$f>;
  19    close $f;
  20 }
  21
  22 binmode STDOUT, ":utf8";
  23
  24 our ($jid, $pw, $inputfile, $redis_host, $redis_port);
  25 require 'config.pl';
  26
  27 warn "# $jid <- $inputfile\n";
  28
  29 read_messages ($inputfile);
  30
  31 my $j       = AnyEvent->condvar;
  32 my $cl      = AnyEvent::XMPP::Client->new (debug => 1);
  33 my $disco   = AnyEvent::XMPP::Ext::Disco->new;
  34 my $version = AnyEvent::XMPP::Ext::Version->new;
  35
  36 $cl->add_extension ($disco);
  37 $cl->add_extension ($version);
  38
  39 $cl->set_presence (undef, 'I\'m a talking bot.', 1);
  40
  41 $cl->add_account ($jid, $pw);
  42 warn "connecting to $jid...\n";
  43
  44 my $redis = AnyEvent::Redis->new( host => $redis_host, port => $redis_port );
  45
  46 $cl->reg_cb (
  47    session_ready => sub {
  48       my ($cl, $acc) = @_;
  49       warn "connected!\n";
  50    },
  51    message => sub {
  52       my ($cl, $acc, $msg) = @_;
  53       my $talkmsg = $msgs[int (rand (@msgs))];
  54       my $repl = $msg->make_reply;
  55       $repl->add_body ("You said '".$msg->any_body."' but... " . $talkmsg);
  56       warn "Got message: '".$msg->any_body."' from ".$msg->from."\n";
  57       warn "Answered: $talkmsg\n";
  58
  59                 $redis->publish( join(' ', 'channel', $msg->from), $msg->any_body );
  60
  61       $repl->send;
  62    },
  63    contact_request_subscribe => sub {
  64       my ($cl, $acc, $roster, $contact) = @_;
  65       $contact->send_subscribed;
  66       warn "Subscribed to ".$contact->jid."\n";
  67    },
  68    error => sub {
  69       my ($cl, $acc, $error) = @_;
  70       warn "Error encountered: ".$error->string."\n";
  71       $j->broadcast;
  72    },
  73    disconnect => sub {
  74       warn "Got disconnected: [@_]\n";
  75       $j->broadcast;
  76    },
  77 );
  78
  79 $cl->start;
  80
  81 $j->wait;