mumble/scripts/weblist.pl

#! /usr/bin/perl

use warnings;
use strict;

# If we're being run as a CGI in suexec, $HOME doesn't exist. Fake it.
my $home = (getpwuid($<))[7];

# This needs to be done before "use Net::DBus"
if (open(F, "$home/murmur/.dbus.sh")) {
  while(<F>) {
    chomp();
    if ($_ =~ /^(.+?)\='(.+)';$/) {
      $ENV{$1}=$2;
    }
  }
  close(F);
}

use Net::DBus;
use CGI;
use CGI::Carp qw(fatalsToBrowser);

my $q = new CGI;

print $q->header();
print $q->start_html(-title=>"Userlist");

my $bus;
my $service;

# First try the system bus
eval {
  $bus=Net::DBus->system();
  $service = $bus->get_service("net.sourceforge.mumble.murmur");
};

# If that failed, the session bus
if (! $service) {
  eval {
    $bus = Net::DBus->session();
    $service = $bus->get_service("net.sourceforge.mumble.murmur");
  }
}

die "Murmur service not found" if (! $service);

# Fetch handle to remote object
my $object = $service->get_object("/");
# Call a function on the murmur object
my $servers = $object->getBootedServers();

foreach my $server (@{$servers}) {
  my $name = $object->getConf($server, "registername");
  print "<h1>Server #$server $name</h1>\n";
  print "<table><tr><th>Name</th><th>Channel</th></tr>\n";
  my $servobj = $service->get_object("/$server");

  # First, get channel names
  my $channels = $servobj->getChannels();
  my %channels;
  foreach my $c (@{$channels}) {
    my @c = @{$c};
    my $id = $c[0];
    my $name = $c[1];
    $channels{$id}=$name;
  }

  # Then, get and print the players
  my $players = $servobj->getPlayers();
  foreach my $p (@{$players}) {
    my @p = @{$p};
    my $chanid = $p[6];
    my $name = $p[8];
    my $chan = $channels{$chanid};
    print "<tr><td>$name</td><td>$chan</td></tr>\n";
  }
  print "</table>\n";
}

print $q->end_html();