Perché devo inviare più messaggi alla mia bot Jabber prima che possa logout?

Question

Sto cercando di fare il mio bot Jabber, ma ho incontrato un po 'di problemi. Ho ottenuto il mio bot per rispondere ai messaggi, tuttavia, se provo a cambiare la presenza del bot, allora sembra che tutti i messaggi inviati al bot arrivare in ritardo.

Quello che voglio dire è quando faccio funzionare lo scritto cambio la presenza così posso vedere che è in linea. Poi, quando mando un messaggio ci vogliono tre prima della subroutine richiamata ho predisposto per i messaggi viene chiamato. Dopo il messaggio thirrd viene inviato e la chat subroutine si chiama ancora elaborare il primo messaggio che ho inviato.

Questo in realtà non presenta troppo di un problema, tranne che ce l'ho impostato per disconnettersi quando invio il messaggio "Logout" e deve essere seguito da altri due messaggi al fine di effettuare il logout. Non sono sicuro che cosa è che devo fare per risolvere questo problema, ma penso che abbia qualcosa a che fare con i pacchetti iq perché ho un callback iq impostato come bene e viene chiamato due volte dopo aver impostato la presenza.

Qui è il mio codice sorgente:

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

Grazie per il vostro aiuto!

Answer 1

Hai fame di risorse a causa della vostra routine keepItGoing. In generale, cercando di utilizzare XMPP sincrono come questo non è andare a lavorare. Vi consigliamo di prendere i vostri callback impostare, poi basta chiamare Process () in una del ciclo.

La documentazione per il processo () dicono:

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.

Ogni volta che si chiama Process (), 0 o più dei vostri callback sparerà. Non si sa mai che, in quanto dipende tempistica server. Se si desidera per Process () per restituire prima di inviare qualcosa, si è quasi sempre a pensare in modo sincrono, piuttosto che asych, che uccide in XMPP.

Nel tuo caso, se si rimuove la chiamata a keepItGoing dalla chat (), scommetto che le cose funzioneranno più come ci si aspetta.

Answer 2

Sostituire la riga:

$jabberBot->Process(1);

con questi:

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