我努力使自己的Jabber机器人,但我已经遇到了一点小麻烦。我已经得到了我的机器人来响应消息,但是,如果我试图改变机器人的存在,然后它好像您发送给机器人的消息得到延迟。

我的意思是,当我跑我改变的存在,所以我可以看到,它是在线的脚本。后来,当我向它发送一个消息,这我已成立的消息被调用的回调例程之前有三个。发送后的thirrd消息和聊天子程序调用它仍然处理我发的第一条消息。

这真的不会构成太大的问题,只是我把它设置为登录时,我发送消息“注销”,它必须跟两个更多的消息,以注销。我是不知道,我必须做些什么来解决这一点,但我认为这是与智商数据包,因为我有一个智商回调集以及和它被设置存在后调用两次。

下面是我的源代码:

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

感谢您的帮助!

有帮助吗?

解决方案

您已经得到了,因为你的keepItGoing程序的资源匮乏。在一般情况下,尝试使用XMPP同步这样是不会工作。我建议让您的回调成立,那么就调用一个循环过程()。

过程的文档()说:

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.

每个调用过程(时间),0以上的回调将闪光。你永远不知道它,因为它取决于服务器时机。如果您想为过程()来送点东西之前回来,你总是想着同步,而不是asych,它可以杀死你的XMPP。

在你的情况,如果你从聊天()删除调用keepItGoing,我敢打赌,事情会更喜欢你的期望。

其他提示

将行:

$jabberBot->Process(1);

与这些:

while (defined($jabberBot->Process(1))) {
    # Do stuff here
}
许可以下: CC-BY-SA归因
不隶属于 StackOverflow
scroll top