Pourquoi dois-je envoyer plusieurs messages à mon bot Jabber avant qu'il dconnecter?

Question

Je suis en train de faire mon propre bot Jabber mais j'ai rencontré un peu de mal. Je l'ai obtenu mon bot pour répondre aux messages, mais si je tente de changer la présence du bot, alors il semble que tous les messages que vous envoyez au bot retardés.

Ce que je veux dire est quand je lance le script que je change la présence que je puisse voir qu'il est en ligne. Puis, quand je l'envoie un message, il prend trois avant le sous-programme de rappel, je l'ai mis en place pour les messages est appelé. Une fois le message est envoyé thirrd et le sous-programme de chat est appelé encore traiter le premier message envoyé.

Cela ne pose vraiment pas trop d'un problème, sauf que je l'ai mis en place pour vous déconnecter quand j'envoie le message « Déconnexion » et il doit être suivi de deux autres messages afin de vous déconnecter. Je ne sais pas ce qu'il est que je dois faire pour corriger cela, mais je pense qu'il a quelque chose à voir avec les paquets iq parce que j'ai mis un rappel iq aussi bien et il est appelé deux fois après avoir réglé la présence.

Voici mon code source:

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

Merci pour votre aide!

Answer 1

Vous avez faim de ressources à cause de votre routine keepItGoing. En général, en essayant d'utiliser XMPP comme synchroniquement cela ne va pas travailler. Je vous conseille de prendre votre callbacks mis en place, puis tout le processus appelant () une boucle .

Les documents pour le procédé (dit):

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.

Chaque fois que vous appelez Process (), 0 ou plus de vos callbacks sera le feu. Vous ne savez jamais qui, puisqu'il dépend du moment du serveur. Si vous voulez pour le processus () pour revenir avant d'envoyer quelque chose, vous pensez presque toujours synchrone, plutôt que asych, qui vous tue dans XMPP.

Dans votre cas, si vous supprimez l'appel à keepItGoing de discussion (), je parie que les choses vont plus comme prévu.

Answer 2

Remplacez la ligne:

$jabberBot->Process(1);

avec celles-ci:

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