Hubs configuration in XML format based on globsterctl - script for the Globster direct connect client

globster-xmlconf.pl

#!/usr/bin/perl

use strict;
use warnings;
use XML::Simple;

# create xml object
my $xml = new XML::Simple;

# read XML file
my $config = $xml->XMLin($ARGV[0], ForceArray => [ 'hub' ], SearchPath => [ '/etc/globster' ]);
my @hubs = @{$config->{'hub'}};

$ENV{DBUS_SESSION_BUS_ADDRESS} = $config->{'dbusaddr'} ? $config->{'dbusaddr'} : $ENV{DBUS_SESSION_BUS_ADDRESS};

eval { require Net::DBus; 1; }
	or die "The Net::DBus perl module does not seem to be installed on your machine.\nPlease install it if you wish to use this program.\n";

my $g = Net::DBus->find->get_service("net.blicky.Globster")->get_object("/net/blicky/Globster");
my $hubm = $g->get_child_object("/HubManager");

sub gethub {
	my $id = shift;
	my $h = $g->get_child_object("/Hub/$id");
	die "No hub object with id=$id.\n" if !eval { $h->Ping; 1 };
	$h;
}

sub propset {
	my($obj, $prop, $val) = @_;

	# Net::DBus doesn't do type inference for properties, so let's do it ourself.
	my $ins = Net::DBus::Binding::Introspector->new(object_path => $obj->get_object_path(), xml => $obj->Introspect());
	my $itf = [$ins->has_property($prop)]->[0];
	die "No property by the name '$prop'.\n" if !$itf;

	# XXX: %simple_type_map is undocumented. No idea on which Net::DBus versions this works.
	no warnings 'once';
	$obj->Set('', $prop, Net::DBus::Binding::Value->new($Net::DBus::Binding::Introspector::simple_type_map{ $ins->get_property_type($itf, $prop) }, $val));
}

sub hubset {
	my($id, $var, $val) = @_;
	my $h = gethub($id);
	propset $h, $var, $val;
	printf "hub($id).$var changed to $val\n";
}

sub hubconnect {
	my($id, $addr) = @_;
	my $h = gethub($id);
	$h->Connect($addr, 58);
	printf "Connected to $addr (".$h->Get('', 'ResolvedAddress').")\n";
}

for my $hub (@hubs) {
	my $id = $hubm->Create();
	printf "Hub created with id=$id\n";
	hubset $id, 'MyNick', $hub->{'nick'};
	if ($hub->{'description'}) {
		hubset $id, 'MyDescription', $hub->{'description'};
	}
	if ($hub->{'password'}) {
		hubset $id, 'MyPassword', $hub->{'password'};
	}
	hubconnect $id, $hub->{'address'};
}