Frage

Ich versuche, mein eigenes Jabber-Bot zu machen, aber ich habe in eine wenig Schwierigkeiten. Ich habe meine Bot reagieren auf Nachrichten bekommen, aber wenn ich versuche, die Präsenz des Bot zu ändern dann scheint es, als ob all die Nachrichten, die Sie an den Bot senden Auslieferung verzögert sich.

Was ich meine ist, wenn ich das Skript ausführen ich die Gegenwart verändern, damit ich sehen kann, dass es online ist. Dann, wenn ich ihm eine Nachricht zu senden dauert es drei vor dem Callback-Unterprogramm I gesetzt habe für Nachrichten aufgerufen wird. Nachdem die thirrd Nachricht gesendet wird und das Chat-Unterprogramm wird es nach wie vor die erste Nachricht, die ich geschickt verarbeiten genannt.

Das ist wirklich Pose nicht zu viel von einem Problem, außer, dass ich es einrichten, um sich abzumelden, wenn ich die Meldung „Abmeldung“ senden und es muss durch zwei weitere Meldungen befolgt werden, um sich abzumelden. Ich bin nicht sicher, was es ist, dass ich dies tun muß, beheben, aber ich denke, es hat etwas mit iq Paketen zu tun hat, weil ich auch eine iq Rückruf gesetzt habe und es wird zwei Mal aufgerufen, nachdem die Anwesenheit Einstellung.

Hier ist mein Quellcode:

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

Vielen Dank für Ihre Hilfe!

War es hilfreich?

Lösung

Sie haben Ihre keepItGoing Routine wegen Ressource Hunger bekommen. In der Regel versuchen, synchron zu verwenden XMPP wie dies zur Arbeit nicht geht. Ich schlage vor, bekommen Sie Ihre Rückrufe einrichten, dann nur anrufen Process () in ein Schleife.

Die Dokumentation für Process () sagen:

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.

Jedes Mal, wenn Sie Prozess () aufrufen, 0 oder mehrere Ihrer Rückrufe ausgelöst. Man weiß nie, welche, da sie auf dem Server Timing abhängt. Wenn Sie Process () wollen etwas zurückgeben vor dem Senden, sind Sie fast immer synchron, anstatt asych denken, die Sie in XMPP tötet.

In Ihrem Fall, wenn Sie den Anruf keepItGoing von Chat () entfernen, ich wette, die Dinge mehr funktionieren wie erwartet.

Andere Tipps

Ersetzen Sie die Zeile:

$jabberBot->Process(1);

mit diesen:

while (defined($jabberBot->Process(1))) {
    # Do stuff here
}
Lizenziert unter: CC-BY-SA mit Zuschreibung
Nicht verbunden mit StackOverflow
scroll top