Jarek has asked for the wisdom of the Perl Monks concerning the following question:
I really appreciate your help. Thank you very much in advance. Regards, Jarek#!/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"; }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Jabber MUC bot channel list problem.
by TomDLux (Vicar) on May 24, 2011 at 18:24 UTC | |
by Jarek (Novice) on May 25, 2011 at 09:17 UTC | |
by oxone (Friar) on May 25, 2011 at 21:59 UTC | |
by Jarek (Novice) on May 27, 2011 at 08:33 UTC |