Por que preciso enviar várias mensagens para meu bot Jabber antes de ele sair?

Question

Estou tentando fazer meu próprio bot Jabber, mas tive alguns problemas.Consegui que meu bot respondesse às mensagens, no entanto, se eu tentar alterar a presença do bot, parece que todas as mensagens que você envia para o bot serão atrasadas.

O que quero dizer é que quando executo o script mudo a presença para poder ver que está online.Então, quando eu envio uma mensagem, leva três antes que a sub-rotina de retorno de chamada que configurei para mensagens seja chamada.Depois que a terceira mensagem for enviada e a sub-rotina de chat for chamada, ela ainda processará a primeira mensagem que enviei.

Isso realmente não representa um grande problema, exceto que eu o configurei para efetuar logout quando enviar a mensagem "logout" e deve ser seguido por mais duas mensagens para efetuar logout.Não tenho certeza do que devo fazer para corrigir isso, mas acho que tem algo a ver com pacotes iq porque também tenho um retorno de chamada iq definido e ele é chamado duas vezes após definir a presença.

Aqui está meu código fonte:

#!/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;
}

Obrigado pela ajuda!

Answer 1

Você está com falta de recursos por causa de sua rotina keepItGoing.Em geral, tentar usar o XMPP de forma síncrona dessa forma não vai funcionar.Sugiro configurar seus retornos de chamada e, em seguida, chamar Process() em um laço.

Os documentos para Process() dizem:

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.

Cada vez que você chamar Process(), 0 ou mais de seus retornos de chamada serão acionados.Você nunca sabe qual, pois depende do tempo do servidor.Se você deseja que Process() retorne antes de enviar algo, quase sempre você pensa de forma síncrona, em vez de asych, o que o mata no XMPP.

No seu caso, se você remover a chamada para keepItGoing do chat(), aposto que as coisas funcionarão mais como você espera.

Answer 2

Substitua a linha:

$jabberBot->Process(1);

com estas:

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