为什么我必须向 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) - 将超时时间作为参数。如果没有
                   列出超时，然后该功能将阻塞，直到
                   收到一个数据包。否则它会等待
                   秒数然后退出所以你的程序
                   可以继续做有用的事情。注意：这是
                   对于 GUI 来说很重要。你需要留出时间
                   即使您正在等待，也可以处理 GUI 命令
                   数据包。以下是可能的回报
                   价值观及其含义：

                       1 - 状态正常，已收到数据。
                       0 - 状态正常，未收到数据。
                     undef - 状态不正常，停止处理。

                   重要提示：您需要检查每个的输出
                   过程。如果你得到一个 undef 那么连接
                   死了，你应该采取相应的行为。

每次调用 Process() 时，都会触发 0 个或多个回调。你永远不知道哪个，因为这取决于服务器计时。如果您希望 Process() 在发送内容之前返回，那么您几乎总是同步思考，而不是异步思考，这会在 XMPP 中杀死您。

就您而言，如果您从 chat() 中删除对 keepItGoing 的调用，我敢打赌事情会更像您期望的那样。

Answer 2

将行： 替换

$jabberBot->Process(1);

为：

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