package Bot::Backbone::Service::JabberChat;
$Bot::Backbone::Service::JabberChat::VERSION = '0.160630';
use v5.10;
use Bot::Backbone::Service;

with qw(

use Bot::Backbone::Message;
use AnyEvent::XMPP::Client;
use AnyEvent::XMPP::Ext::Disco;
use AnyEvent::XMPP::Ext::MUC;

# ABSTRACT: Connect and chat with a Jabber server

has username => (
    is          => 'ro',
    isa         => 'Str',
    required    => 1,

has domain => (
    is          => 'ro',
    isa         => 'Str',
    required    => 1,

has group_domain => (
    is          => 'ro',
    isa         => 'Str',
    required    => 1,
    lazy        => 1,
    default     => sub {
        my $self = shift;
        return join '.', 'conference', $self->domain

has resource => (
    is          => 'ro',
    isa         => 'Str',
    required    => 1,
    default     => 'backbone-bot',

has password => (
    is          => 'ro',
    isa         => 'Str',
    required    => 1,

has host => (
    is          => 'ro',
    isa         => 'Str',

has port => (
    is          => 'ro',
    isa         => 'Int',

has connection_args => (
    is          => 'ro',
    isa         => 'HashRef',

has debug_client => (
    is          => 'ro',
    isa         => 'Bool',
    required    => 1,
    default     => 0,

has xmpp_debug_send_callback => (
    is          => 'ro',
    isa         => 'CodeRef',
    predicate   => 'has_xmpp_debug_send_callback',

has xmpp_debug_recv_callback => (
    is          => 'ro',
    isa         => 'CodeRef',
    predicate   => 'has_xmpp_debug_recv_callback',

has xmpp_client => (
    is          => 'ro',
    isa         => 'AnyEvent::XMPP::Client',
    required    => 1,
    lazy_build  => 1,

sub _build_xmpp_client { 
    my $self = shift;

    my $client = AnyEvent::XMPP::Client->new(
        debug => $self->debug_client,

    for my $type (qw( send recv )) {
        my $has_callback = "has_xmpp_debug_${type}_callback";
        my $get_callback = "xmpp_debug_${type}_callback";

        if ($self->$has_callback) {
            my $callback = $self->$get_callback;
                "debug_$type" => sub {
                    my ($client, $acc, $data) = @_;
                    $callback->($self, $client, $acc, $data);

    return $client;

has xmpp_disco => (
    is          => 'ro',
    isa         => 'AnyEvent::XMPP::Ext::Disco',
    required    => 1,
    lazy_build  => 1,

sub _build_xmpp_disco { AnyEvent::XMPP::Ext::Disco->new }

has xmpp_muc => (
    is          => 'ro',
    isa         => 'AnyEvent::XMPP::Ext::MUC',
    required    => 1,
    lazy_build  => 1,

sub _build_xmpp_muc {
    my $self = shift;
    AnyEvent::XMPP::Ext::MUC->new( disco => $self->xmpp_disco );

has session_ready => (
    is          => 'rw',
    isa         => 'Bool',
    required    => 1,
    default     => 0,

has group_options => (
    is          => 'rw',
    isa         => 'ArrayRef[HashRef]',
    required    => 1,
    default     => sub { [] },
    traits      => [ 'Array' ],
    handles     => {
        all_group_options => 'elements',
        add_group_options => 'push',

has error_callback => (
    is          => 'rw',
    isa         => 'CodeRef',
    lazy_build  => 1,

sub _build_error_callback {
    return sub {
        my ($self, $message) = @_;
        warn "XMPP Error: ", $message, "\n";

sub jid {
    my $self = shift;
    return $self->username
         . '@' . $self->domain
         . '/' . $self->resource;

sub group_jid {
    my ($self, $name) = @_;
    return $name . '@' . $self->group_domain,

sub xmpp_account {
    my $self = shift;
    return $self->xmpp_client->get_account($self->jid);

sub xmpp_connection {
    my $self = shift;
    return $self->xmpp_account->connection;

sub xmpp_room {
    my ($self, $name) = @_;
    return $self->xmpp_muc->get_room(

sub xmpp_contact {
    my ($self, $name) = @_;
    return $self->xmpp_connection->get_roster->get_contact($name);

sub initialize {
    my $self = shift;

    # Make the connection

    # TODO These messages should really verify that they are intended for us by
    # checking that the account passed is the account expected. Otherwise, if
    # someone were to setup multiple JabberChat connections using the same
    # client (which we ought to expect), all JabberChats will react to all
    # connections simultaneously... which is bad.

    # Register the IM message callback
        session_ready => sub { 

            # Register the extensions we use

        message       => sub { $self->got_direct_message(@_) },

        # TODO Need more robust logging
        error         => sub { 
            my ($client, $account, $error) = @_;
            $self->error_callback->($self, $error->string);

    # Register the group message callback
        message => sub { $self->got_group_message(@_) },

    # Start the client

sub _join_pending_groups {
    my $self = shift;

    # Perform join from either the params or list of group options
    my @pending_group_options;
    if (@_) {
        @pending_group_options = @_;
    else {
        @pending_group_options = $self->all_group_options;

    my $account = $self->xmpp_account;
    my $conn    = $self->xmpp_connection;

    # Join each group requested
    for my $group_options (@pending_group_options) {
        my $nickname = $account->nickname_for_jid($self->jid);
        $nickname = $group_options->{nickname}
            if defined $group_options->{nickname};


sub join_group {
    my ($self, $options) = @_;

    $self->_join_pending_groups($options) if $self->session_ready;

sub _identity_from_jid {
    my ($self, $jid) = @_;

    my $contact = $self->xmpp_contact($jid);

    if (defined $contact) {
        return Bot::Backbone::Identity->new(
            username => $contact->jid,
            nickname => $contact->name // $contact->jid,
            me       => $contact->is_me,
    else {
        return Bot::Backbone::Identity->new(
            username => $jid,
            nickname => $jid,
            me       => 0,

sub got_direct_message {
    my ($self, $client, $account, $xmpp_message) = @_;

    return unless defined $xmpp_message->body;

    my $to_contact   = $self->xmpp_contact($xmpp_message->to);
    my $from_contact = $self->xmpp_contact($xmpp_message->from);

    my $message = Bot::Backbone::Message->new({
        chat => $self,
        from => $self->_identity_from_jid($xmpp_message->to),
        to   => $self->_identity_from_jid($xmpp_message->from),
        group => undef,
        text  => $xmpp_message->body,

    if ($self->has_dispatcher) {

sub is_to_me {
    my ($self, $me_user, $text) = @_;

    my $me_nick = $me_user->nick;
    return scalar($$text =~ s/^ $me_nick \s* [:,\-]
                             |  , \s* $me_nick [.!?]? $
                             |  , \s* $me_nick \s* , 

sub got_group_message {
    my ($self, $client, $room, $xmpp_message, $is_echo) = @_;

    # Ignore messages echoed back to the bot
    return if $is_echo;

    # Ignore messages from the room itself
    return unless defined $xmpp_message->from_nick;

    # Ignore delayed messages (e.g., received as a replay of recent room discussion)
    return if $xmpp_message->is_delayed;

    # Figure out which group this is
    my $group_domain = $self->group_domain;
    my $group        =  $room->jid;
       $group        =~ s/\@$group_domain$//;

    # Figure out who sent this message
    my $from_user = $room->get_user($xmpp_message->from_nick);

    # Prefer the real JID as the username
    my $from_username = $from_user->real_jid // $from_user->in_room_jid;
    my $from_nickname = $from_user->nick;

    # This will never actually be true right now, but in case I decide
    # handling echos is a good thing someday...
    my $me_user = $room->get_me;
    my $is_me   = $me_user->in_room_jid eq $from_user->in_room_jid;

    # See if the group message is talking to us...
    my $to_identity;
    my $text    = $xmpp_message->body;
    if ($self->is_to_me($me_user, \$text)) {
        $to_identity = Bot::Backbone::Identity->new(
            username => $me_user->real_jid // $me_user->in_room_jid,
            nickname => $me_user->nick,
            me       => 1,

    # Is this a message sent privately within the room?
    my $private = $xmpp_message->is_private;
    my $volume  = $private ? 'whisper' : 'spoken';

    # Build the message
    my $message = Bot::Backbone::Message->new({
        chat => $self,
        from => Bot::Backbone::Identity->new(
            username => $from_username,
            nickname => $from_nickname,
            me       => $is_me,
        to     => $to_identity,
        group  => $group,
        text   => $text,
        volume => $volume,

    # Pass it on

sub send_message {
    my ($self, $params) = @_;

    my $to    = $params->{to};
    my $group = $params->{group};
    my $text  = $params->{text};
    my $contact;

    # Select a group to receive the message
    if (defined $group) {
        $contact = $self->xmpp_room($group);

    # Select a contect to receive the message
    else {
        $contact = $self->xmpp_contact($to);

    unless (defined $contact) {
        Carp::carp("JabberChat: no contact found for $to/$group to send $text\n");

    $contact->make_message(body => $text)->send;




=encoding UTF-8

=head1 NAME

Bot::Backbone::Service::JabberChat - Connect and chat with a Jabber server

=head1 VERSION

version 0.160630


  service jabber_chat => (
      service  => 'JabberChat',
      username => 'bot',
      domain   => '',
      resource => 'coolbot',
      password => 'secret',


Connects to and chats directly with other users and chat groups using a Jabber
(XMPP) server.


=head2 username

This is the username (or localpart in XMPP parlance) to use when connecting to the Jabber server. E.g., if your bot's login name is C<>, the username is "bot".

=head2 domain

This is the domain (or domainpart) to use when connecting to the Jabber server. E.g., f your bot's login mame is C<>, the domain is "".

=head2 group_domain

This is the domain to contact for group chats. Normally, this is the same as L</domain>, but with "conference." tacked on at the front.

=head2 resource

This is a the resourcepart of your login name. You may not really care what this is set to, but it shows up in some chat clients. By default it will be set to "backbone-bot", but you can set it something else, if you like.

=head2 password

This is the password to use when logging in to the Jabber server.

=head2 host

This is the host to contact to login. If not set, the L</domain> will be used.

If you run your bot on Google Talk, you will probably want this set to L<>.

=head2 port

This is the port to connect. If you do not set it to anything, the default of 5222 will be used.

=head2 connection_args

These are additional connection arguments to pass to the XMPP connector. See
L<AnyEvent::XMPP::Connection> for a list of available options.

=head2 debug_client

Set to true if you want to enable debugging. This uses the built-in debug option
of L<AnyEvent::XMPP::Client>. If you want more control over how debugging is
handled, see L</xmpp_debug_recv_callback> and L</xmpp_debug_send_callback>.

=head2 xmpp_debug_send_callback

=head2 xmpp_debug_recv_callback

These attributes may be set to a code reference that will be called with every
message received from the XMPP server. This could be useful for troubleshooting
certain kinds of problems in cases where you'd like more control over the output
than you get from L</debug>.

Each will be called like this:

  $callback->($service, $xmpp_client, $account, $data);

The C<$service> is this object. The C<$xmpp_client> will be the same object as
is returned by L</xmpp_client>. The C<$account> is the
L<AnyEvent::XMPP::Account> the bot has connected as (useful for getting the
jid). And the C<$data> is the raw XML being sent or received.

=head2 xmpp_client

This is the XMPP client object for organizing connections.

=head2 xmpp_disco

This is the XMPP discovery extension helper.

=head2 xmpp_muc

This is the XMPP multi-user chat extension helper.

=head2 session_ready

Once the connection has been made and is ready to start sending and receiving
messages, this will be set to true.

=head2 group_options

This is a list of multi-user chat groups the bot has joined or intends to join
once L</session_ready> becomes true.

=head2 error_callback

This callback is executed in case of an error. It will receive two arguments
like so:

  $callback->($service, $message);

The first argument is the L<Bot::Backbone::Service::JabberChat> object and the
second is the error message the server sent. The default handler uses warn to
log the message to the console.

=head1 METHODS

=head2 jid

This assembles a full JID (Jabber ID) using the L</username>, L</domain>, and

=head2 group_jid

  my $group_jid = $chat->group_jid('bar');

Given a short group name, returns the bare JID for that group.

=head2 xmpp_account

Returns the XMPP account object.

=head2 xmpp_connection

Returns teh XMPP connection object.

=head2 xmpp_room

  my $xmpp_room = $chat->xmpp_room('qux');

Returns the XMPP room object for the named room.

=head2 xmpp_contact

  my $xmpp_contact = $chat->xmpp_contact('');

Given a JID, returns the XMPP contact object for that user.

=head2 initialize

Connects to the Jabber server and registers the events for receiving messages
from it.

=head2 join_group

Asks to join the named multi-user chat groups on the Jabber server. If L</session_ready> is false, the chat service will only record a desire to join the group. No actual join will take place. Once the session becomes ready, all pending groups will be joined.

If the session is ready already, then the group will be joined immediately.


=head2 got_direct_message

Whenever someone sends the bot a direct message throught eh Jabber server, this
handler is called. It builds a L<Bot::Backbone::Message> and then passes that
message on the associated chat consumers and the dispatcher.

=head2 is_to_me

  my $bool = $self->is_to_me($user, \$text);

Given the user that identifies the bot in a group chat and text that was just
sent to the chat, this detects if the message was directed at the bot. Normally,
this includes messages that start with the following:

  nick: ...
  nick, ...
  nick- ...

It also includes suffix references like this:

  ..., nick.
  ..., nick

and infix references like this:

  ..., nick, ...

If you want something different, you may subclass service and override this

Note that the text is sent as a reference and can be modified, usually to remove
the nick from the message so the bot does not have to worry about that.

=head2 got_group_message

Whenever someone posts to a conference room that the bot has joined, this method
will be called to create a L<Bot::Backbone::Message> and pass that message on to
chat consumers and the dispatcher.

=head2 send_message

Sends a message to the Jabber server for a direct chat or group.

=head1 AUTHOR

Andrew Sterling Hanenkamp <>


This software is copyright (c) 2016 by Qubling Software LLC.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.