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