Почему мне нужно отправить несколько сообщений моему Jabber-боту, прежде чем он выйдет из системы?

Question

Я пытаюсь создать своего собственного Jabber-бота, но столкнулся с небольшой проблемой.Я заставил своего бота отвечать на сообщения, однако, если я попытаюсь изменить присутствие бота, создается впечатление, что все сообщения, которые вы отправляете боту, задерживаются.

Я имею в виду, что когда я запускаю сценарий, я меняю присутствие, чтобы видеть, что он онлайн.Затем, когда я отправляю ему сообщение, требуется три, прежде чем будет вызвана подпрограмма обратного вызова, которую я настроил для сообщений.После отправки третьего сообщения и вызова подпрограммы чата она все равно обрабатывает первое отправленное мной сообщение.

На самом деле это не представляет особой проблемы, за исключением того, что я настроил выход из системы, когда я отправляю сообщение «выход из системы», и за ним должны следовать еще два сообщения, чтобы выйти из системы.Я не уверен, что мне нужно сделать, чтобы это исправить, но я думаю, что это как-то связано с пакетами iq, потому что у меня также установлен обратный вызов iq, и он вызывается два раза после установки присутствия.

Вот мой исходный код:

#!/usr/bin/perl

use strict;
use warnings;

#Libraries
use Net::Jabber;
use DBI;
use DBD::mysql;

#--------------- Config Vars -----------------
# Jabber Client
my $jbrHostname = "DOMAINNAME"; 
my $jbrUserName = "USERNAME";
my $jbrPassword = "PASSWORD";
my $jbrResource = "RESOURCE";
my $jbrBoss = new Net::Jabber::JID();
$jbrBoss->SetJID(userid=>"USERNAME",server=>$jbrHostname);

# MySQL
my $dbHostname = "DOMAINNAME";
my $dbName = "DATABASENAME";
my $dbUserName = "USERNAME";
my $dbPassword = "PASSWORD";
#--------------- End Config -----------------

# connect to the db
my $dbh = DBI->connect("DBI:mysql:database=$dbName;host=$dbHostname",$dbUserName, $dbPassword, {RaiseError => 1}) or die "Couldn't connect to the database: $!\n";

# create a new jabber client and connect to server
my $jabberBot = Net::Jabber::Client->new();
my $status = $jabberBot->Connect(hostname=>$jbrHostname) or die "Cannot connect ($!)\n";
my @results = $jabberBot->AuthSend(username=>$jbrUserName,password=>$jbrPassword,resource=>$jbrResource);

if($results[0] ne "ok")
{
    die "Jabber auth error @results\n";
}

# set jabber bot callbacks
$jabberBot->SetMessageCallBacks(chat=>\&chat);
$jabberBot->SetPresenceCallBacks(available=>\&welcome);
$jabberBot->SetCallBacks(iq=>\&gotIQ);

$jabberBot->PresenceSend(type=>"available");
$jabberBot->Process(1);

sub welcome
{
    $jabberBot->MessageSend(to=>$jbrBoss->GetJID(),subject=>"",body=>"Hello There!",type=>"chat",priority=>10);
    &keepItGoing;
}

$jabberBot->MessageSend(to=>$jbrBoss->GetJID(),subject=>"",body=>"Hello There! Global...",type=>"chat",priority=>10);
#$jabberBot->Process(5);
&keepItGoing;

sub chat
{
    print "Chat Called!\n";
    my ($sessionID,$msg) = @_;
    $jabberBot->MessageSend(to=>$msg->GetFrom(),subject=>"",body=>"Chatting!",type=>"chat",priority=>10);
    if($msg->GetBody() ne 'logout')
    {
        print $msg->GetBody()."\n";
        &keepItGoing;
    }
    else
    {
        &killBot($msg);
    }

}

sub gotIQ
{
    print $_[1]->GetID()."\n";
    &chat;
}

sub keepItGoing
{
    print "Movin' the chains!\n";
    my $proc = $jabberBot->Process(1);
    while(defined($proc) && $proc != 1)
    {
        $proc = $jabberBot->Process(1);
    }
}

sub killBot
{
    $jabberBot->MessageSend(to=>$_[0]->GetFrom(),subject=>"",body=>"Logging Out!",type=>"chat",priority=>10);
    $jabberBot->Process(1);
    $jabberBot->Disconnect();
    exit;
}

Спасибо за вашу помощь!

Answer 1

У вас нехватка ресурсов из-за вашей рутины KeepItGoing.В общем, попытка синхронного использования XMPP таким образом не сработает.Я предлагаю настроить обратные вызовы, а затем просто вызвать Process() в один петля.

Документы для Process() говорят:

Process(integer) - takes the timeout period as an argument.  If no
                   timeout is listed then the function blocks until
                   a packet is received.  Otherwise it waits that
                   number of seconds and then exits so your program
                   can continue doing useful things.  NOTE: This is
                   important for GUIs.  You need to leave time to
                   process GUI commands even if you are waiting for
                   packets.  The following are the possible return
                   values, and what they mean:

                       1   - Status ok, data received.
                       0   - Status ok, no data received.
                     undef - Status not ok, stop processing.

                   IMPORTANT: You need to check the output of every
                   Process.  If you get an undef then the connection
                   died and you should behave accordingly.

Каждый раз, когда вы вызываете Process(), срабатывает 0 или более ваших обратных вызовов.Никогда не знаешь, что именно, поскольку это зависит от тайминга сервера.Если вы хотите, чтобы Process() возвращался перед отправкой чего-либо, вы почти всегда думаете синхронно, а не асинхронно, что убивает вас в XMPP.

В вашем случае, если вы удалите вызов KeepItGoing из Chat(), я уверен, что все будет работать так, как вы ожидаете.

Answer 2

Замените строку:

$jabberBot->Process(1);

с этими:

while (defined($jabberBot->Process(1))) {
    # Do stuff here
}