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 use Storable;
  12 use Data::Dump qw(dump);
  13
  14 binmode STDOUT, ":utf8";
  15
  16 our ($jid, $pw, $inputfile, $redis_host, $redis_port);
  17 require 'config.pl';
  18
  19 warn "# $jid <- $inputfile\n";
  20
  21 my $j       = AnyEvent->condvar;
  22 my $cl      = AnyEvent::XMPP::Client->new (debug => 1);
  23 my $disco   = AnyEvent::XMPP::Ext::Disco->new;
  24 my $version = AnyEvent::XMPP::Ext::Version->new;
  25
  26 $cl->add_extension ($disco);
  27 $cl->add_extension ($version);
  28
  29 $cl->set_presence (undef, 'I\'m a talking bot.', 1);
  30
  31 $cl->add_account ($jid, $pw);
  32 warn "connecting to $jid...\n";
  33
  34 my $pub = AnyEvent::Redis->new( host => $redis_host, port => $redis_port );
  35 my $sub = AnyEvent::Redis->new( host => $redis_host, port => $redis_port );
  36
  37 my $subscriptions = eval { retrieve '/tmp/subs' };
  38
  39 sub subscribe_channel {
  40         my ( $who, $to ) = @_;
  41         warn "# subscribe_channel $who $to\n";
  42
  43         $subscriptions->{$who}->{$to} ||= time;
  44
  45         $sub->psubscribe( "channel $to", sub {
  46                 my ( $message, $from ) = @_;
  47                 return unless $from !~ m/\Q($to|$jid)\E/; # skip our messages
  48                 warn "#Q<< $from [$jid] | $message\n";
  49                 my ( undef, $channel, $user ) = split(/ /,$from,3);
  50                 $cl->send_message( "$channel <$user> $message", $who => $jid, 'chat' );
  51         });
  52
  53         store $subscriptions, '/tmp/subs';
  54 }
  55
  56 foreach my $who ( keys %$subscriptions ) {
  57         foreach my $to ( keys %{ $subscriptions->{$who} } ) {
  58                 subscribe_channel $who => $to;
  59         }
  60 }
  61
  62 $cl->reg_cb (
  63    session_ready => sub {
  64       my ($cl, $acc) = @_;
  65       warn "connected!\n";
  66    },
  67    message => sub {
  68                 my ($cl, $acc, $msg) = @_;
  69
  70                 my $response = '...';
  71
  72                 my $body = $msg->any_body;
  73
  74                 my $channel = join(' ', 'channel', $msg->from);
  75                 $pub->publish( $channel, $body );
  76                 warn "#X<< $channel | $body\n";
  77
  78                 if ( $msg =~ m/!subscribe\s+(\S+)/ ) {
  79                         subscribe_channel $msg->from => $1;
  80                         $response = "subscribed to: " . dump( $subscriptions->{$msg->from} );
  81
  82                 }
  83
  84                 my $repl = $msg->make_reply;
  85                 $repl->add_body( $response );
  86                 $repl->send;
  87                 warn "#>>> $response\n";
  88
  89    },
  90    contact_request_subscribe => sub {
  91       my ($cl, $acc, $roster, $contact) = @_;
  92       $contact->send_subscribed;
  93       warn "Subscribed to ".$contact->jid."\n";
  94    },
  95    error => sub {
  96       my ($cl, $acc, $error) = @_;
  97       warn "Error encountered: ".$error->string."\n";
  98       $j->broadcast;
  99    },
 100    disconnect => sub {
 101       warn "Got disconnected: [@_]\n";
 102       $j->broadcast;
 103    },
 104 );
 105
 106 $cl->start;
 107
 108 $j->wait;