view release on metacpan or  search on metacpan

lib/DJabberd/Bot.pm  view on Meta::CPAN

package DJabberd::Bot;
use strict;
use warnings;
use base 'DJabberd::Plugin';
use DJabberd::JID;
use Carp;
use Scalar::Util;
use List::Util qw(first);
use DJabberd::BotContext;

our $logger = DJabberd::Log->get_logger();

### store the object in a closure, so we can retrieve it later
{   my $singleton;
    sub singleton { $singleton };
    
    sub new {
        my $self = shift;
        $singleton = $self->SUPER::new( @_ );
    }
}

sub set_config_nodename {
    my ($self, $nodename) = @_;
    $self->{nodename} = $nodename;
}

sub set_config_resource {
    my ($self, $resource) = @_;
    $self->{resource} = $resource;
}

sub finalize {
    my ($self) = @_;

    Carp::confess("Bot needs a nodename") unless $self->{nodename};
    $self->{resource} ||= "bot";
}

sub jid {
    return $_[0]->{jid};
}

sub bound_jid {
    return $_[0]->jid;
}

sub vhost {
    return $_[0]->{vhost};
}

sub register {
    my ($self, $vhost) = @_;
    my $barejid = DJabberd::JID->new("$self->{nodename}\@" . $vhost->server_name );
    my $resource = $self->{resource};

    $self->{vhost} = $vhost;
    Scalar::Util::weaken($self->{vhost});

    my $reg_jid;
    my $regcb = DJabberd::Callback->new({
        registered => sub {
            (undef, $reg_jid) = @_;
            $logger->debug("Bot $reg_jid is now registered");
        },
        error => sub {
            $logger->error("Bot $barejid/$resource failed to register");
            },
    });

    $vhost->register_jid($barejid, $resource, $self, $regcb);
    if ($reg_jid) {
        $self->{jid} = $reg_jid;
        DJabberd::Presence->set_local_presence(
            $self->{jid},
            DJabberd::Presence->available( from => $self->{jid} )
        );
    }
}

# no-op bot logic:
sub process_text {
    my ($self, $text, $from, $cb) = @_;
    $cb->done;
}

# TODO: not yet used.
sub context_timeout { 300 }

sub get_context {
    my ($self, $method, $fromjid) = @_;
    # TODO: cache these, and time them out according to $self->context_timeout
    if ($method eq "stanza") {
        return DJabberd::BotContext->new($self->{vhost}, $method, $fromjid, $self->jid);
    }
}


############################################################################
# Connection-like methods, for when we're pretending to be a roster item, and registered
# ourselves with jidmap.  (as opposed to being a component)
############################################################################

sub write {
    # currently don't do anything here
    $logger->warn("Ignoring writes");
}

sub is_available { 1 }

sub requested_roster { 0 }

sub send_stanza {
    my ($self, $stanza) = @_;

    if ($stanza->isa('DJabberd::Message')) {
        my ($text, $html);
        # find the plaintext