Skip to content

Instantly share code, notes, and snippets.

Last active January 10, 2016 14:58
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save mimicmod/79b088d664154686f561 to your computer and use it in GitHub Desktop.
Hubs configuration in XML format based on globsterctl - script for the Globster direct connect client
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 };
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'};
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment