Why do I have to send multiple messages to my Jabber bot before it will logout?
I am trying to make my own Jabber bot but i have run into a little trouble. I have gotten my bot to respond to messages, however, if I try to change the bot's presence then it seems as though all of the messages you send to the bot get delayed.
What I mean is when I run the script I change the presence so I can see that it is online. Then when I send it a message it takes three before the callback subroutine I have set up for messages gets called. After the thirrd message is sent and the chat subroutine is called it still process the first message I sent.
This really doesn't pose too much of a problem except that I have it set up to log out when I send the message "logout" and it has to be followed by two more messages in order to log out. I am not sure what it is that I have to do to fix this but i think it has something to do with iq packets because I have an iq callback set as well and it gets called two times after setting the presence.
Here is my source code:
#!/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 @resultsn"; } # 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; }
Thanks for your help!
You've got resource starvation because of your keepItGoing routine. In general, trying to use XMPP synchronously like this is not going to work. I suggest getting your callbacks set up, then just calling Process() in one loop.
The docs for Process() say:
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.
Each time you call Process(), 0 or more of your callbacks will fire. You never know which, since it depends on server timing. If you want for Process() to return before sending something, you're almost always thinking synchronously, rather than asych, which kills you in XMPP.
In your case, if you remove the call to keepItGoing from chat(), I bet things will work more like you expect.
Replace the line:
$jabberBot->Process(1);
with these:
while (defined($jabberBot->Process(1))) {
# Do stuff here
}
链接地址: http://www.djcxy.com/p/16810.html
上一篇: Jabber集成到网站和多个域中