Check Online Users script

DBI # included in most distributions DBD::mysql # for use with mysql Jabber::Connection # needed for jabber communication

[2004-04-22 22:47 CDT] zhs0567 (email) wee
[2004-07-19 12:51 CDT] gcm (email) might be prudent to have a create table () statement in the comments

#!/usr/bin/perl -w
#
# skript to check who's online
# stores online status in db
###############################################################################
# BEGIN LICENSE BLOCK
###############################################################################
# Copyright (C) 2003 Stefan Strigler <steve@zeank.in-berlin.de>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
###############################################################################
# END LICENSE BLOCK
##############################################################################
#
# global configuration-data
#
##############################################################################
use strict;

use DBI;
use Jabber::Connection;

###############################################################################
# config below

###############################################################################
# DATABASE
###############################################################################
# How to access the SQL database:
my %DBCONFIG = (
	     "base"     => "mysql",
	     "host"     => "localhost",		# where is the database?
	     "port"     => 3306,	 				# which port to use
	     "name"     => "glubs",		# name of the MySQL database
	     "datasource" => "dbi:mysql:glubs",	# DEPRICATED, use above ones!
			 "username" => "root",				# user to attach to the MySQL database
	     "password" => ""							# Some people actually use passwords...
	    );

my $DBTABLE = "person";
my $DBJID = "jid"; # name of row (where jid is stored)
my $DBJIDSTATUS = "presence"; # name of row where to store online status
	# sql: presence enum('available', 'away', 'xa', 'chat', 'dnd', 'unavailable') NOT NULL default 'unavailable'

###############################################################################
# Jabber configuration
###############################################################################
my $JABBERSERVER = 'jabber.zeank.in-berlin.de';
my $JADMINUSER = 'zeank';
my $JADMINPASS = 'hkm18g';

my $DEBUG = 1;
# end config
###############################################################################

###############################################################################
# dbConnect
# Create a global connection object.
#
# PARAMS:
# $config - hash containing db-config (see GlubsGlobals.pm for details)
#
# RETURN:
# $dbh - database handle
###############################################################################
sub dbConnect {
    my ($config) = @_;
		print STDERR "getting new db connection.\n" if ($DEBUG);
    my %config = %$config;
    my $dbh = DBI->connect($config{'datasource'}, $config{'username'}, $config{'password'}, { RaiseError => 1 });
    return $dbh;
}

###############################################################################
# dbSQL
# Sends a SQL statement to the server, checks for errors, and returns an sth.
#
# $dbh - Database-handle
# $SQL - SQL-Statement to be executed
# $debug - unused
###############################################################################
sub dbSQL {
    my ($dbh, $sql_statement, $debug) = @_;
    print STDERR "SQL: $sql_statement\n" if($DEBUG);
    #Prepare and error checking.
    my $sth = $dbh->prepare($sql_statement);
    $sth->execute;
    return $sth;
}


# construct query
my $nf = new Jabber::NodeFactory();

my $node = $nf->newNode('iq');
$node->attr('type', 'get');
$node->attr('to', $JABBERSERVER);
my $query = $node->insertTag('query', 'jabber:iq:admin');
$query->insertTag('who');

print "Query:\n".$node->toStr . "\n\n" if($DEBUG);

my $c = new Jabber::Connection(server => $JABBERSERVER);

die "oops: ".$c->lastError unless $c->connect();

$c->auth($JADMINUSER,$JADMINPASS,'jabberd'); # client auth

my $result = $c->ask($node);

if ($DEBUG) {
	print "---\nResult is:\n", $result->toStr;
	print "\n---\n";
}

my @presence = $result->getTag('query')->getTag('who')->getTag('presence');

my @online_users;

foreach (@presence) {
	next if (defined($_->attr('type')) && $_->attr('type') eq 'unavailable');
	my %row;
	
#	print $_->attr('from');
	if ($_->attr('from') =~ /^(.+)\/.+/) {
		$row{jid} = $1;
		if (defined($_->getTag('show'))) {
			$row{show} = $_->getTag('show')->data();
		} else {
			$row{show} = 'available';
		}
		if (defined($_->getTag('status'))) {
			$row{status} = $_->getTag('status')->data();
		}
	}
	push (@online_users,\%row);
}

if ($DEBUG) {
	print @online_users . " users online:\n";
	foreach (@online_users) {
		print "\t" . $_->{jid} . "\n";
	}
}

# now update db

my $dbh = &dbConnect(\%DBCONFIG);

dbSQL($dbh,"LOCK TABLES $DBTABLE WRITE");

dbSQL($dbh,"UPDATE $DBTABLE SET $DBJIDSTATUS='unavailable'");

foreach (@online_users) {
	dbSQL($dbh,"UPDATE $DBTABLE SET $DBJIDSTATUS='$_->{show}' WHERE $DBJID = '$_->{jid}'");
}

dbSQL($dbh,"UNLOCK TABLES");
$dbh->disconnect;
# Disconnect
$c->disconnect();