我正在尝试制作自己的Jabber机器人,但我遇到了一些麻烦。我已经让我的机器人响应消息,但是,如果我尝试更改机器人的存在,那么似乎所有发送给机器人的消息都会延迟。
我的意思是当我运行脚本时,我改变了状态,以便我可以看到它在线。然后,当我发送一条消息时,在我为消息设置的回调子例程被调用之前需要三个消息。发送thirrd消息并调用聊天子例程后,它仍处理我发送的第一条消息。
这确实不会造成太多问题,除了我将其设置为在我发送消息“logout”时注销,并且必须再输出两条消息才能注销。我不知道我必须做些什么才能解决这个问题,但我认为它与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; }
感谢您的帮助!
答案 0 :(得分:0)
由于你的keepItGoing例程,你已经资源匮乏了。一般来说,尝试像这样同步使用XMPP是行不通的。我建议设置回调,然后在一个循环中调用Process()。
Process()的文档说:
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.
每次调用Process()时,都会触发0个或更多回调。你永远不知道哪个,因为它取决于服务器的时间。如果你想让Process()在发送之前返回,你几乎总是同步思考,而不是asych,这会在XMPP中杀死你。
在你的情况下,如果你从chat()中删除keepItGoing的调用,我认为事情将会更像你期望的那样。
答案 1 :(得分:0)
替换行:
$jabberBot->Process(1);
用这些:
while (defined($jabberBot->Process(1))) {
# Do stuff here
}