lib/App/Clifton/Tower/Jabber.pm

   1 package App::Clifton::Tower::Jabber;
   2
   3 use aliased 'App::Clifton::UserConfigSet';
   4 use aliased 'App::Clifton::ChainSetByJabberUser' => 'ChainSet';
   5 use aliased 'Net::Async::XMPP::Client' => 'XMPP_Client';
   6 use Log::Contextual qw(:log);
   7 use Moo;
   8
   9 extends 'App::Clifton::Component';
  10
  11 has xmpp_client => (is => 'lazy');
  12
  13 sub xmpp_active { shift->xmpp_client->xmpp->is_loggedin }
  14
  15 has $_ => (is => 'ro', required => 1)
  16   for qw(bridge_name jabber_config irc_config);
  17
  18 has server => (is => 'ro', required => 1, weak_ref => 1);
  19
  20 has userconfig_set => (
  21   is => 'ro', # Moobug init_arg => undef,
  22   default => sub { UserConfigSet->new }
  23 );
  24
  25 has chain_set => (
  26   is => 'ro', # Moobug init_arg => undef,
  27   default => sub { ChainSet->new }
  28 );
  29
  30 has full_jid => (is => 'rw');
  31
  32 sub _build_xmpp_client {
  33   my ($self) = @_;
  34   $self->_login_xmpp_client($self->_new_child(XMPP_Client, {
  35     on_message => $self->_replace_weakself('handle_message'),
  36   }));
  37 }
  38
  39 sub _login_xmpp_client {
  40   my ($self, $xmpp) = @_;
  41   my $conf = $self->jabber_config;
  42   $xmpp->login(
  43     jid => $conf->user, host => $conf->server, password => $conf->pass,
  44   );
  45   $xmpp;
  46 }
  47
  48 sub BUILD { $_[0]->xmpp_client }
  49
  50 sub handle_message {
  51   my ($self, $msg) = @_;
  52
  53   my $me = $self->jabber_config->user;
  54
  55   return log_info {
  56     "Received error message"
  57   } if $msg->type eq 'error';
  58
  59   return log_debug {
  60     "Received message for ${\$msg->to} instead of $me - ignoring"
  61   } unless $msg->to =~ /^\Q$me/; # may be foo@gmail.com or .../gsklgsh
  62
  63   if (!$self->full_jid
  64       or ($self->full_jid !~ m{/} and $msg->to =~ m{/})
  65     ) {
  66     $self->full_jid($msg->to); # need foo@gmail.com/skldshgsdg here
  67   }
  68
  69   (my $from = $msg->from) =~ s/\/.*//;
  70
  71   return log_debug {
  72     "Received message from me ($me) - ignoring"
  73   } if $from eq $me;
  74
  75   return log_debug {
  76     "Received message from user ${from} not in my config"
  77   } unless my $user = $self->userconfig_set->get({ name => $from });
  78
  79   if (my $chain = $self->chain_set->get({ jabber_user => $from })) {
  80     $chain->handle_xmpp_message($msg);
  81   } else {
  82     if ($msg->body =~ m{^\s*/start\s*$}) {
  83       $self->send_xmpp_message({
  84         to => $from, body => 'Connecting ...'
  85       });
  86       $self->start_chain_for($user)->on_finished(
  87         $self->_capture_weakself(sub {
  88           my ($self, $result) = @_;
  89           if ($result->{chain}) {
  90             $self->chain_set->add($result->{chain});
  91           }
  92           $self->send_xmpp_message({
  93             to => $from, body => 'Connection result: '.$result->{message}
  94           });
  95         })
  96       );
  97     } else {
  98       $self->send_xmpp_message({
  99         to => $from,
 100         body => 'Not currently connected - send /start to connect'
 101       });
 102     }
 103   }
 104 }
 105
 106 sub send_xmpp_message {
 107   my ($self, $args) = @_;
 108   s/&/&amp;/g, s/"/&quot;/g, s/</&lt;/g, s/>/&gt;/g for $args->{body};
 109   $args->{from} = $self->full_jid;
 110   $self->xmpp_client->compose(%$args)->send;
 111 }
 112
 113 sub start_chain_for {
 114   my ($self, $user) = @_;
 115   $self->server->start_chain({
 116     jabber_tower => $self,
 117     jabber_user => $user->name,
 118     irc_tower => {
 119       server => $self->irc_config->server,
 120       irc_nick => $user->irc_nick
 121     },
 122     irc_channel => $self->irc_config->channel,
 123   });
 124 }
 125
 126 1;
 127
 128 # and later
 129
 130 # package App::Clifton::Tower::IRC;
 131
 132 # has irc_client
 133
 134 # has irc_server_name
 135
 136 # has user_config
 137
 138 # has chain_set
 139
 140 # package App::Clifton::Chain
 141
 142 #