Jarek has asked for the wisdom of the Perl Monks concerning the following question:

Hi guys, My brain has got enough for today but I have got a problem. I was bored and decided I will write a simple bot which is going to welcome all guests joining the channel. Well... I thought it will be simple bot but I was a bit wrong ;). I don't want to use any MySQL databases or such a things. I just wanted to keep the code simple as possible. So the first problem I faced with was no proper status when someone joins the channel. The client only sends a presence to the channel so we know someone is available. So in effect bot was inviting everyone who's status was changed ;). So the idea was to join the channel by the bot, get a list of users, put that into the array and if someone will leave, remove it from the list, if someone will change the status check against the array if the JID is already in. Everything is fine, but... it doesn't want to work. I managed to create a list, eliminate duplicates (if exists) and remove JID when the user left. The problem is when anyone changes the status bot adds this user's JID again to the list. I put some "debugging" to check what is the status of $index variable which tells where the JID is in the array and if it doesn't exist, put that JID, however even if JID exists and $index is returned as 0 or other, condition !$index doesn't work. This is what I have got:
#!/usr/bin/perl + + use Net::Jabber; use Data::Dumper; use strict; use Fcntl qw(:flock); my @roster; my $server = "server.tld"; my $port = "5222"; my $username = "user"; my $password = "pass"; my $resource = "BOT"; my $Connection; my %roster=(); my $en_jid; startbot(); sub startbot() { #### PREVENT FORKING #### open (FILE, '>> bot.lock') or die "Cannot open file"; flock(FILE, LOCK_EX|LOCK_NB) or die "Process already running"; ######################### $Connection = new Net::Jabber::Client(); $Connection->SetCallBacks(presence=>\&InPresence, iq=>\&InIQ, mess +age=>\&InMessage); my $status = $Connection->Connect(hostname=>$server,port=>$port); + if (!(defined($status))) + { + print "ERROR: Jabber server is down or connection was not all +owed.\n"; print " ($!)\n"; + exit(0); + } my @result = $Connection->AuthSend( username=>$username, password=>$password, resource=>$resource); if ($result[0] ne "ok") { print "ERROR: Authorization failed: $result[0] - $result[1]\n" +; exit(0); + } + print "Logged in to $server:$port...\n"; + $Connection->MUCJoin( + room=>"test", + server=>"chat.server.tld", nick=>"Robot"); + while(defined($Connection->Process())) {} + } sub InMessage { my $sid = shift; my $message = shift; my $xml = $message->GetXML(); print "Message \n"; print $xml ."\n"; print "\n"; } sub InIQ { my $sid = shift; my $iq = shift; my $xml = $iq->GetXML(); print "IQ \n"; print $xml ."\n"; print "\n"; } sub InPresence { my $i; my $index; my @jid; my $jid; my $roster_size = $#roster; my $sid = shift; my $presence = shift; my $xml = $presence->GetXML(); my $type = $presence->GetType(); $jid = $xml =~ /jid='(.*)'/; @jid = split /\//, $1; $jid = $jid[0]; my $from = $presence->GetFrom(); my @from = split /\//, $from; $from=$from[0]; print "Presence \n"; print $xml ."\n"; print "Type: $type\n"; print "\n"; print "Roster size = $roster_size\n"; print "Index before for: $index\n"; for ($i = 0; $i < $roster_size+1; $i++) { if($roster[$i] =~ /^$jid$/) { $index = $i; print "JID $jid found, Index: $index\n"; print "Index inside for: $index\n"; last; } else { push @roster, $jid; } } print "Index after for: $index\n"; if (!$index and $type !~ /unavailable/) { print "Index in if: $index\n"; push @roster, $jid; } elsif ($type =~ /unavailable/) { print "Removing user $jid from Index $index\n"; splice @roster, $index, 1; } else { print "Nothing\n"; } print "Index after if: $index"; print "\n=================== ROSTER =====================\n"; print "@roster"; print "\n=================== ROSTER =====================\n"; }
I really appreciate your help. Thank you very much in advance. Regards, Jarek

Replies are listed 'Best First'.
Re: Jabber MUC bot channel list problem.
by TomDLux (Vicar) on May 24, 2011 at 18:24 UTC

    I would store users as a hash, rather than an array, making it much faster to determine whether the person is already in the list, or not, and also making deletions simpler.

    my %roster; # to test for person being present, using a hash: if ( $roster{$jid} ) { .... } # to delete people when they leave: delete $roster{$jid};

    I would re-initialize the list from the channel, say every half hour, to avoid going out of sync with reality. You might have some bug which loses people, or there might be a network problem which results in people joining or leaving without you being properly notified.

    As for your code not working as you want it to, are you testing individual routines one by one, using Test::More or other testing frameworks? Can you run the program under the debugger, and determine data, inputs and outputs just before and just after an arrival ... use a private channel, where you can control arrivals. How about outputting a flood of data to a log file, and manually determining whether it's Doing The Right Thing?

    As Occam said: Entia non sunt multiplicanda praeter necessitatem.

      Hi,

      Thank you for your reply. The one thing I cannot imagine a bit is how do I use this hash to store users. How do I add user to that hash ? If $jid is a key, then each key ($jid) must have a value. What is that value ? Anything ? Also I created some test script which checks your way of thinking.

      Please take a look:

      #!/usr/bin/perl use Data::Dumper; my %roster; @jid= qw |test1 test2 test3 test4|; foreach $jid (@jid) { $roster{$jid} = "0"; } foreach $jid (@jid) { print Dumper ($roster{$jid}); } @keys = keys %roster; print "Keys: @keys\n"; $jid = "test1"; if ($roster{$jid}) { print "something"; }
      Why the last if doesn't print "something" if the key exists ?

      Thank you for your help

      Regards.

        Any true value is fine for your hash, but unfortunately you've chosen 0 which isn't true. Use 1 instead, and the last test will then work as you want it to.