2006-07-07 Carlos Garnacho <carlosg@gnome.org>

        * AUTHORS.Net-DBus, COPYING.Net-DBus, Net-DBus/*, configure.in,
        Makefile.am: Modified patch from Frederic Peters  <fpeters@0d.be> to
        include an internal copy of Net::DBus.

34 files changed, 10133 insertions, 0 deletions

diff --git a/Net-DBus/DBus.xs b/Net-DBus/DBus.xs
new file mode 100644
index 0000000..9da25af
--- /dev/null
+++ b/Net-DBus/DBus.xs
@@ -0,0 +1,1432 @@
+/* -*- c -*-
+ *
+ * Copyright (C) 2004-2006 Daniel P. Berrange
+ *
+ * This program is free software; You can redistribute it and/or modify
+ * it under the same terms as Perl itself. Either:
+ *
+ * a) the GNU General Public License as published by the Free
+ *   Software Foundation; either version 2, or (at your option) any
+ *   later version,
+ *
+ * or
+ *
+ * b) the "Artistic License"
+ *
+ * The file "COPYING" distributed along with this file provides full
+ * details of the terms and conditions of the two licenses.
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <dbus/dbus.h>
+
+#if PD_DO_DEBUG
+#define PD_DEBUG(...) if (getenv("PD_DEBUG")) fprintf(stderr, __VA_ARGS__)
+#else
+#define PD_DEBUG(...)
+#endif
+
+
+/* The -1 is required by the contract for
+   dbus_{server,connection}_allocate_slot
+   initialization */
+dbus_int32_t connection_data_slot = -1;
+dbus_int32_t server_data_slot = -1;
+dbus_int32_t pending_call_data_slot = -1;
+
+void
+_object_release(void *obj) {
+    PD_DEBUG("Releasing object count on %p\n", obj);
+    SvREFCNT_dec((SV*)obj);
+}
+
+dbus_bool_t
+_watch_generic(DBusWatch *watch, void *data, char *key, dbus_bool_t server) {
+    SV *selfref;
+    HV *self;
+    SV **call;
+    SV *h_sv;
+    dSP;
+
+    PD_DEBUG("Watch generic callback %p %p %s %d\n", watch, data, key, server);
+
+    if (server) {
+      selfref = (SV*)dbus_server_get_data((DBusServer*)data, server_data_slot);
+    } else {
+      selfref = (SV*)dbus_connection_get_data((DBusConnection*)data, connection_data_slot);
+    }
+    self = (HV*)SvRV(selfref);
+
+    PD_DEBUG("Got owner %p\n", self);
+
+    call = hv_fetch(self, key, strlen(key), 0);
+
+    if (!call) {
+      warn("Could not find watch callback %s for fd %d\n",
+	   key, dbus_watch_get_fd(watch));
+      return FALSE;
+    }
+
+    ENTER;
+    SAVETMPS;
+
+    PUSHMARK(SP);
+    XPUSHs(selfref);
+    h_sv = sv_newmortal();
+    sv_setref_pv(h_sv, "Net::DBus::Binding::C::Watch", (void*)watch);
+    XPUSHs(h_sv);
+    PUTBACK;
+
+    call_sv(*call, G_DISCARD);
+
+    FREETMPS;
+    LEAVE;
+
+    return 1;
+}
+
+dbus_bool_t
+_watch_server_add(DBusWatch *watch, void *data) {
+    return _watch_generic(watch, data, "add_watch", 1);
+}
+void
+_watch_server_remove(DBusWatch *watch, void *data) {
+    _watch_generic(watch, data, "remove_watch", 1);
+}
+void
+_watch_server_toggled(DBusWatch *watch, void *data) {
+    _watch_generic(watch, data, "toggled_watch", 1);
+}
+
+dbus_bool_t
+_watch_connection_add(DBusWatch *watch, void *data) {
+    return _watch_generic(watch, data, "add_watch", 0);
+}
+void
+_watch_connection_remove(DBusWatch *watch, void *data) {
+    _watch_generic(watch, data, "remove_watch", 0);
+}
+void
+_watch_connection_toggled(DBusWatch *watch, void *data) {
+    _watch_generic(watch, data, "toggled_watch", 0);
+}
+
+
+dbus_bool_t
+_timeout_generic(DBusTimeout *timeout, void *data, char *key, dbus_bool_t server) {
+    SV *selfref;
+    HV *self;
+    SV **call;
+    SV *h_sv;
+    dSP;
+
+    if (server) {
+      selfref = (SV*)dbus_server_get_data((DBusServer*)data, server_data_slot);
+    } else {
+      selfref = (SV*)dbus_connection_get_data((DBusConnection*)data, connection_data_slot);
+    }
+    self = (HV*)SvRV(selfref);
+
+    call = hv_fetch(self, key, strlen(key), 0);
+
+    if (!call) {
+      warn("Could not find timeout callback for %s\n", key);
+      return FALSE;
+    }
+
+    ENTER;
+    SAVETMPS;
+
+    PUSHMARK(SP);
+    XPUSHs((SV*)selfref);
+    h_sv = sv_newmortal();
+    sv_setref_pv(h_sv, "Net::DBus::Binding::C::Timeout", (void*)timeout);
+    XPUSHs(h_sv);
+    PUTBACK;
+
+    call_sv(*call, G_DISCARD);
+
+    FREETMPS;
+    LEAVE;
+
+    return 1;
+}
+
+dbus_bool_t
+_timeout_server_add(DBusTimeout *timeout, void *data) {
+    return _timeout_generic(timeout, data, "add_timeout", 1);
+}
+void
+_timeout_server_remove(DBusTimeout *timeout, void *data) {
+    _timeout_generic(timeout, data, "remove_timeout", 1);
+}
+void
+_timeout_server_toggled(DBusTimeout *timeout, void *data) {
+    _timeout_generic(timeout, data, "toggled_timeout", 1);
+}
+
+dbus_bool_t
+_timeout_connection_add(DBusTimeout *timeout, void *data) {
+    return _timeout_generic(timeout, data, "add_timeout", 0);
+}
+void
+_timeout_connection_remove(DBusTimeout *timeout, void *data) {
+    _timeout_generic(timeout, data, "remove_timeout", 0);
+}
+void
+_timeout_connection_toggled(DBusTimeout *timeout, void *data) {
+    _timeout_generic(timeout, data, "toggled_timeout", 0);
+}
+
+void
+_connection_callback (DBusServer *server,
+		      DBusConnection *new_connection,
+		      void *data) {
+    SV *selfref = (SV*)dbus_server_get_data((DBusServer*)data, server_data_slot);
+    HV *self = (HV*)SvRV(selfref);
+    SV **call;
+    SV *value;
+    dSP;
+
+    call = hv_fetch(self, "_callback", strlen("_callback"), 0);
+
+    if (!call) {
+      warn("Could not find new connection callback\n");
+      return;
+    }
+
+    PD_DEBUG("Created connection in callback %p\n", new_connection);
+    /* The DESTROY method will de-ref it later */
+    dbus_connection_ref(new_connection);
+
+    value = sv_newmortal();
+    sv_setref_pv(value, "Net::DBus::Binding::C::Connection", (void*)new_connection);
+
+    ENTER;
+    SAVETMPS;
+
+    PUSHMARK(SP);
+    XPUSHs(selfref);
+    XPUSHs(value);
+    PUTBACK;
+
+    call_sv(*call, G_DISCARD);
+
+    FREETMPS;
+    LEAVE;
+}
+
+
+DBusHandlerResult
+_message_filter(DBusConnection *con,
+		DBusMessage *msg,
+		void *data) {
+    SV *selfref;
+    HV *self;
+    SV *value;
+    int count;
+    int handled = 0;
+    dSP;
+
+    selfref = (SV*)dbus_connection_get_data(con, connection_data_slot);
+    self = (HV*)SvRV(selfref);
+
+    PD_DEBUG("Create message in filter %p\n", msg);
+    PD_DEBUG("  Type %d\n", dbus_message_get_type(msg));
+    PD_DEBUG("  Interface %s\n", dbus_message_get_interface(msg) ? dbus_message_get_interface(msg) : "");
+    PD_DEBUG("  Path %s\n", dbus_message_get_path(msg) ? dbus_message_get_path(msg) : "");
+    PD_DEBUG("  Member %s\n", dbus_message_get_member(msg) ? dbus_message_get_member(msg) : "");
+    /* Will be de-refed in the DESTROY method */
+    dbus_message_ref(msg);
+    value = sv_newmortal();
+    sv_setref_pv(value, "Net::DBus::Binding::C::Message", (void*)msg);
+
+    ENTER;
+    SAVETMPS;
+
+    PUSHMARK(SP);
+    XPUSHs((SV*)selfref);
+    XPUSHs(value);
+    XPUSHs(data);
+    PUTBACK;
+
+    count = call_method("_message_filter", G_SCALAR);
+    /* XXX POPi prints use of uninitialized value ?!?!?! */
+if (0) {
+    if (count == 1) {
+      handled = POPi;
+    } else {
+      handled = 0;
+    }
+}
+    FREETMPS;
+    LEAVE;
+
+    return handled ? DBUS_HANDLER_RESULT_HANDLED : DBUS_HANDLER_RESULT_NOT_YET_HANDLED;
+}
+
+void
+_pending_call_callback(DBusPendingCall *call,
+		       void *data) {
+    SV *selfref;
+    HV *self;
+    dSP;
+
+    selfref = (SV*)dbus_pending_call_get_data(call, pending_call_data_slot);
+    self = (HV*)SvRV(selfref);
+
+    dbus_pending_call_ref(call);
+
+    ENTER;
+    SAVETMPS;
+
+    PUSHMARK(SP);
+    XPUSHs((SV*)selfref);
+    PUTBACK;
+
+    call_sv(data, G_DISCARD);
+
+    FREETMPS;
+    LEAVE;
+}
+
+void
+_filter_release(void *data) {
+    SvREFCNT_dec(data);
+}
+
+void
+_pending_call_notify_release(void *data) {
+    SvREFCNT_dec(data);
+}
+
+void
+_path_unregister_callback(DBusConnection *con,
+			  void *data) {
+    SvREFCNT_dec(data);
+}
+
+DBusHandlerResult
+_path_message_callback(DBusConnection *con,
+		       DBusMessage *msg,
+		       void *data) {
+    SV *self = (SV*)dbus_connection_get_data(con, connection_data_slot);
+    SV *value;
+    dSP;
+
+    PD_DEBUG("Got message in callback %p\n", msg);
+    PD_DEBUG("  Type %d\n", dbus_message_get_type(msg));
+    PD_DEBUG("  Interface %s\n", dbus_message_get_interface(msg) ? dbus_message_get_interface(msg) : "");
+    PD_DEBUG("  Path %s\n", dbus_message_get_path(msg) ? dbus_message_get_path(msg) : "");
+    PD_DEBUG("  Member %s\n", dbus_message_get_member(msg) ? dbus_message_get_member(msg) : "");
+    /* Will be de-refed in the DESTROY method */
+    dbus_message_ref(msg);
+    value = sv_newmortal();
+    sv_setref_pv(value, "Net::DBus::Binding::C::Message", (void*)msg);
+
+    ENTER;
+    SAVETMPS;
+
+    PUSHMARK(SP);
+    XPUSHs(self);
+    XPUSHs(value);
+    PUTBACK;
+
+    call_sv((SV*)data, G_DISCARD);
+
+    FREETMPS;
+    LEAVE;
+
+    return DBUS_HANDLER_RESULT_HANDLED;
+}
+
+DBusObjectPathVTable _path_callback_vtable = {
+	_path_unregister_callback,
+	_path_message_callback,
+	NULL,
+	NULL,
+	NULL,
+	NULL
+};
+
+SV *
+_sv_from_error (DBusError *error)
+{
+    HV *hv;
+
+    if (!error) {
+      warn ("error is NULL");
+      return &PL_sv_undef;
+    }
+
+    if (!dbus_error_is_set (error)) {
+      warn ("error is unset");
+      return &PL_sv_undef;
+    }
+
+    hv = newHV ();
+
+    /* map DBusError attributes to hash keys */
+    hv_store (hv, "name", 4, newSVpv (error->name, 0), 0);
+    hv_store (hv, "message", 7, newSVpv (error->message, 0), 0);
+
+    return sv_bless (newRV_noinc ((SV*) hv), gv_stashpv ("Net::DBus::Error", TRUE));
+}
+
+void
+_croak_error (DBusError *error)
+{
+    sv_setsv (ERRSV, _sv_from_error (error));
+
+    /* croak does not return, so we free this now to avoid leaking */
+    dbus_error_free (error);
+
+    croak (Nullch);
+}
+
+void
+_populate_constant(HV *href, char *name, int val)
+{
+    hv_store(href, name, strlen(name), newSViv(val), 0);
+}
+
+#define REGISTER_CONSTANT(name, key) _populate_constant(constants, #key, name)
+
+MODULE = Net::DBus		PACKAGE = Net::DBus
+
+PROTOTYPES: ENABLE
+BOOT:
+    {
+	HV *constants;
+
+	/* not the 'standard' way of doing perl constants, but a lot easier to maintain */
+
+	constants = perl_get_hv("Net::DBus::Binding::Bus::_constants", TRUE);
+	REGISTER_CONSTANT(DBUS_BUS_SYSTEM, SYSTEM);
+	REGISTER_CONSTANT(DBUS_BUS_SESSION, SESSION);
+	REGISTER_CONSTANT(DBUS_BUS_STARTER, STARTER);
+
+	constants = perl_get_hv("Net::DBus::Binding::Message::_constants", TRUE);
+	REGISTER_CONSTANT(DBUS_TYPE_ARRAY, TYPE_ARRAY);
+	REGISTER_CONSTANT(DBUS_TYPE_BOOLEAN, TYPE_BOOLEAN);
+	REGISTER_CONSTANT(DBUS_TYPE_BYTE, TYPE_BYTE);
+	REGISTER_CONSTANT(DBUS_TYPE_DOUBLE, TYPE_DOUBLE);
+	REGISTER_CONSTANT(DBUS_TYPE_INT16, TYPE_INT16);
+	REGISTER_CONSTANT(DBUS_TYPE_INT32, TYPE_INT32);
+	REGISTER_CONSTANT(DBUS_TYPE_INT64, TYPE_INT64);
+	REGISTER_CONSTANT(DBUS_TYPE_INVALID, TYPE_INVALID);
+	REGISTER_CONSTANT(DBUS_TYPE_STRUCT, TYPE_STRUCT);
+	REGISTER_CONSTANT(DBUS_TYPE_SIGNATURE, TYPE_SIGNATURE);
+	REGISTER_CONSTANT(DBUS_TYPE_OBJECT_PATH, TYPE_OBJECT_PATH);
+	REGISTER_CONSTANT(DBUS_TYPE_DICT_ENTRY, TYPE_DICT_ENTRY);
+	REGISTER_CONSTANT(DBUS_TYPE_STRING, TYPE_STRING);
+	REGISTER_CONSTANT(DBUS_TYPE_UINT16, TYPE_UINT16);
+	REGISTER_CONSTANT(DBUS_TYPE_UINT32, TYPE_UINT32);
+	REGISTER_CONSTANT(DBUS_TYPE_UINT64, TYPE_UINT64);
+	REGISTER_CONSTANT(DBUS_TYPE_VARIANT, TYPE_VARIANT);
+
+	REGISTER_CONSTANT(DBUS_MESSAGE_TYPE_METHOD_CALL, MESSAGE_TYPE_METHOD_CALL);
+	REGISTER_CONSTANT(DBUS_MESSAGE_TYPE_METHOD_RETURN, MESSAGE_TYPE_METHOD_RETURN);
+	REGISTER_CONSTANT(DBUS_MESSAGE_TYPE_ERROR, MESSAGE_TYPE_ERROR);
+	REGISTER_CONSTANT(DBUS_MESSAGE_TYPE_SIGNAL, MESSAGE_TYPE_SIGNAL);
+	REGISTER_CONSTANT(DBUS_MESSAGE_TYPE_INVALID, MESSAGE_TYPE_INVALID);
+
+	constants = perl_get_hv("Net::DBus::Binding::Watch::_constants", TRUE);
+	REGISTER_CONSTANT(DBUS_WATCH_READABLE, READABLE);
+	REGISTER_CONSTANT(DBUS_WATCH_WRITABLE, WRITABLE);
+	REGISTER_CONSTANT(DBUS_WATCH_ERROR, ERROR);
+	REGISTER_CONSTANT(DBUS_WATCH_HANGUP, HANGUP);
+
+	dbus_connection_allocate_data_slot(&connection_data_slot);
+	dbus_server_allocate_data_slot(&server_data_slot);
+	dbus_pending_call_allocate_data_slot(&pending_call_data_slot);
+    }
+
+
+MODULE = Net::DBus::Binding::Connection		PACKAGE = Net::DBus::Binding::Connection
+
+PROTOTYPES: ENABLE
+
+DBusConnection *
+_open(address)
+	char *address;
+    PREINIT:
+	DBusError error;
+	DBusConnection *con;
+    CODE:
+	dbus_error_init(&error);
+	con = dbus_connection_open(address, &error);
+	if (!con) {
+	  _croak_error (&error);
+	}
+	RETVAL = con;
+    OUTPUT:
+	RETVAL
+
+MODULE = Net::DBus::Binding::C::Connection		PACKAGE = Net::DBus::Binding::C::Connection
+
+void
+_set_owner(con, owner)
+	DBusConnection *con;
+	SV *owner;
+    CODE:
+	SvREFCNT_inc(owner);
+	dbus_connection_set_data(con, connection_data_slot, owner, _object_release);
+
+void
+dbus_connection_disconnect(con)
+	DBusConnection *con;
+
+int
+dbus_connection_get_is_connected(con)
+	DBusConnection *con;
+
+int
+dbus_connection_get_is_authenticated(con)
+	DBusConnection *con;
+
+void
+dbus_connection_flush(con)
+	DBusConnection *con;
+
+int
+_send(con, msg)
+	DBusConnection *con;
+	DBusMessage *msg;
+    PREINIT:
+	dbus_uint32_t serial;
+    CODE:
+	if (!dbus_connection_send(con, msg, &serial)) {
+	  croak("not enough memory to send message");
+	}
+	RETVAL = serial;
+    OUTPUT:
+	RETVAL
+
+DBusMessage *
+_send_with_reply_and_block(con, msg, timeout)
+	DBusConnection *con;
+	DBusMessage *msg;
+	int timeout;
+    PREINIT:
+	DBusMessage *reply;
+	DBusError error;
+    CODE:
+	dbus_error_init(&error);
+	if (!(reply = dbus_connection_send_with_reply_and_block(con, msg, timeout, &error))) {
+	  _croak_error(&error);
+	}
+	PD_DEBUG("Create msg reply %p\n", reply);
+	PD_DEBUG("  Type %d\n", dbus_message_get_type(reply));
+	PD_DEBUG("  Interface %s\n", dbus_message_get_interface(reply) ? dbus_message_get_interface(reply) : "");
+	PD_DEBUG("  Path %s\n", dbus_message_get_path(reply) ? dbus_message_get_path(reply) : "");
+	PD_DEBUG("  Member %s\n", dbus_message_get_member(reply) ? dbus_message_get_member(reply) : "");
+	// XXX needed ?
+	//dbus_message_ref(reply);
+	RETVAL = reply;
+    OUTPUT:
+	RETVAL
+
+
+DBusPendingCall *
+_send_with_reply(con, msg, timeout)
+	DBusConnection *con;
+	DBusMessage *msg;
+	int timeout;
+    PREINIT:
+	DBusPendingCall *reply;
+    CODE:
+	if (!dbus_connection_send_with_reply(con, msg, &reply, timeout)) {
+	  croak("not enough memory to send message");
+	}
+	PD_DEBUG("Create pending call %p\n", reply);
+	// XXX needed ?
+	//dbus_pending_call_ref(reply);
+	RETVAL = reply;
+    OUTPUT:
+	RETVAL
+
+DBusMessage *
+dbus_connection_borrow_message(con)
+	DBusConnection *con;
+
+void
+dbus_connection_return_message(con, msg)
+	DBusConnection *con;
+	DBusMessage *msg;
+
+void
+dbus_connection_steal_borrowed_message(con, msg)
+	DBusConnection *con;
+	DBusMessage *msg;
+
+DBusMessage *
+dbus_connection_pop_message(con)
+	DBusConnection *con;
+
+void
+_dispatch(con)
+	DBusConnection *con;
+    CODE:
+	while(dbus_connection_dispatch(con) == DBUS_DISPATCH_DATA_REMAINS);
+
+void
+_set_watch_callbacks(con)
+	DBusConnection *con;
+    CODE:
+	if (!dbus_connection_set_watch_functions(con,
+						 _watch_connection_add,
+						 _watch_connection_remove,
+						 _watch_connection_toggled,
+						 con, NULL)) {
+	  croak("not enough memory to set watch functions on connection");
+	}
+
+void
+_set_timeout_callbacks(con)
+	DBusConnection *con;
+    CODE:
+	if (!dbus_connection_set_timeout_functions(con,
+						   _timeout_connection_add,
+						   _timeout_connection_remove,
+						   _timeout_connection_toggled,
+						   con, NULL)) {
+	  croak("not enough memory to set timeout functions on connection");
+	}
+
+void
+_register_object_path(con, path, code)
+	DBusConnection *con;
+	char *path;
+	SV *code;
+    CODE:
+	SvREFCNT_inc(code);
+	if (!(dbus_connection_register_object_path(con, path, &_path_callback_vtable, code))) {
+	  croak("failure when registering object path");
+	}
+
+void
+_unregister_object_path(con, path)
+	DBusConnection *con;
+	char *path;
+    CODE:
+	/* The associated data will be free'd by the previously
+	   registered callback */
+	if (!(dbus_connection_unregister_object_path(con, path))) {
+	  croak("failure when unregistering object path");
+	}
+
+void
+_register_fallback(con, path, code)
+	DBusConnection *con;
+	char *path;
+	SV *code;
+    CODE:
+	SvREFCNT_inc(code);
+	if (!(dbus_connection_register_fallback(con, path, &_path_callback_vtable, code))) {
+	  croak("failure when registering fallback object path");
+	}
+
+
+void
+_add_filter(con, code)
+	DBusConnection *con;
+	SV *code;
+    CODE:
+	SvREFCNT_inc(code);
+	PD_DEBUG("Adding filter %p\n", code);
+	dbus_connection_add_filter(con, _message_filter, code, _filter_release);
+
+dbus_bool_t
+dbus_bus_register(con)
+	DBusConnection *con;
+    PREINIT:
+	DBusError error;
+	int reply;
+    CODE:
+	dbus_error_init(&error);
+	if (!(reply = dbus_bus_register(con, &error))) {
+	  _croak_error(&error);
+	}
+	RETVAL = reply;
+
+void
+dbus_bus_add_match(con, rule)
+	DBusConnection *con;
+	char *rule;
+    PREINIT:
+	DBusError error;
+    CODE:
+	dbus_error_init(&error);
+	PD_DEBUG("Adding match %s\n", rule);
+	dbus_bus_add_match(con, rule, &error);
+	if (dbus_error_is_set(&error)) {
+	  _croak_error(&error);
+	}
+
+void
+dbus_bus_remove_match(con, rule)
+	DBusConnection *con;
+	char *rule;
+    PREINIT:
+	DBusError error;
+    CODE:
+	dbus_error_init(&error);
+	PD_DEBUG("Removeing match %s\n", rule);
+	dbus_bus_remove_match(con, rule, &error);
+	if (dbus_error_is_set(&error)) {
+	  _croak_error(&error);
+	}
+
+const char *
+dbus_bus_get_unique_name(con)
+	DBusConnection *con;
+
+int
+dbus_bus_request_name(con, service_name)
+	DBusConnection *con;
+	char *service_name;
+    PREINIT:
+	DBusError error;
+	int reply;
+    CODE:
+	dbus_error_init(&error);
+	if (!(reply = dbus_bus_request_name(con, service_name, 0, &error))) {
+	  _croak_error(&error);
+	}
+	RETVAL = reply;
+    OUTPUT:
+	RETVAL
+
+void
+DESTROY(con)
+	DBusConnection *con;
+   CODE:
+	PD_DEBUG("Destroying connection %p\n", con);
+	dbus_connection_disconnect(con);
+	// XXX do we need this or not ?
+	//dbus_connection_unref(con);
+
+
+MODULE = Net::DBus::Binding::Server		PACKAGE = Net::DBus::Binding::Server
+
+PROTOTYPES: ENABLE
+
+DBusServer *
+_open(address)
+	char *address;
+    PREINIT:
+	DBusError error;
+	DBusServer *server;
+    CODE:
+	dbus_error_init(&error);
+	server = dbus_server_listen(address, &error);
+	PD_DEBUG("Created server %p on address %s", server, address);
+	if (!server) {
+	  _croak_error(&error);
+	}
+	if (!dbus_server_set_auth_mechanisms(server, NULL)) {
+	    croak("not enough memory to server auth mechanisms");
+	}
+	RETVAL = server;
+    OUTPUT:
+	RETVAL
+
+
+MODULE = Net::DBus::Binding::C::Server		PACKAGE = Net::DBus::Binding::C::Server
+
+void
+_set_owner(server, owner)
+	DBusServer *server;
+	SV *owner;
+    CODE:
+	SvREFCNT_inc(owner);
+	dbus_server_set_data(server, server_data_slot, owner, _object_release);
+
+void
+dbus_server_disconnect(server)
+	DBusServer *server;
+
+int
+dbus_server_get_is_connected(server)
+	DBusServer *server;
+
+void
+_set_watch_callbacks(server)
+	DBusServer *server;
+    CODE:
+	if (!dbus_server_set_watch_functions(server,
+					     _watch_server_add,
+					     _watch_server_remove,
+					     _watch_server_toggled,
+					     server, NULL)) {
+	  croak("not enough memory to set watch functions on server");
+	}
+
+
+void
+_set_timeout_callbacks(server)
+	DBusServer *server;
+    CODE:
+	if (!dbus_server_set_timeout_functions(server,
+					       _timeout_server_add,
+					       _timeout_server_remove,
+					       _timeout_server_toggled,
+					       server, NULL)) {
+	  croak("not enough memory to set timeout functions on server");
+	}
+
+
+void
+_set_connection_callback(server)
+	DBusServer *server;
+    CODE:
+	dbus_server_set_new_connection_function(server,
+						_connection_callback,
+						server, NULL);
+
+void
+DESTROY(server)
+	DBusServer *server;
+   CODE:
+	PD_DEBUG("Destroying server %p\n", server);
+	dbus_server_unref(server);
+
+
+MODULE = Net::DBus::Binding::Bus		PACKAGE = Net::DBus::Binding::Bus
+
+PROTOTYPES: ENABLE
+
+DBusConnection *
+_open(type)
+	DBusBusType type;
+    PREINIT:
+	DBusError error;
+	DBusConnection *con;
+    CODE:
+	dbus_error_init(&error);
+	con = dbus_bus_get(type, &error);
+	if (!con) {
+	  _croak_error(&error);
+	}
+	RETVAL = con;
+    OUTPUT:
+	RETVAL
+
+MODULE = Net::DBus::Binding::Message		PACKAGE = Net::DBus::Binding::Message
+
+PROTOTYPES: ENABLE
+
+DBusMessage *
+_create(type)
+	IV type;
+    PREINIT:
+	DBusMessage *msg;
+    CODE:
+	msg = dbus_message_new(type);
+	if (!msg) {
+	  croak("No memory to allocate message");
+	}
+	PD_DEBUG("Create msg new %p\n", msg);
+	PD_DEBUG("  Type %d\n", dbus_message_get_type(msg));
+	RETVAL = msg;
+    OUTPUT:
+	RETVAL
+
+
+DBusMessageIter *
+_iterator_append(msg)
+	DBusMessage *msg;
+    CODE:
+	RETVAL = dbus_new(DBusMessageIter, 1);
+	dbus_message_iter_init_append(msg, RETVAL);
+    OUTPUT:
+	RETVAL
+
+
+DBusMessageIter *
+_iterator(msg)
+	DBusMessage *msg;
+    CODE:
+	RETVAL = dbus_new(DBusMessageIter, 1);
+	dbus_message_iter_init(msg, RETVAL);
+    OUTPUT:
+	RETVAL
+
+
+MODULE = Net::DBus::Binding::C::Message		PACKAGE = Net::DBus::Binding::C::Message
+
+void
+DESTROY(msg)
+	DBusMessage *msg;
+    CODE:
+	PD_DEBUG("De-referencing message %p\n", msg);
+	PD_DEBUG("  Type %d\n", dbus_message_get_type(msg));
+	PD_DEBUG("  Interface %s\n", dbus_message_get_interface(msg) ? dbus_message_get_interface(msg) : "");
+	PD_DEBUG("  Path %s\n", dbus_message_get_path(msg) ? dbus_message_get_path(msg) : "");
+	PD_DEBUG("  Member %s\n", dbus_message_get_member(msg) ? dbus_message_get_member(msg) : "");
+	dbus_message_unref(msg);
+
+dbus_bool_t
+dbus_message_get_no_reply(msg)
+	DBusMessage *msg;
+
+void
+dbus_message_set_no_reply(msg,flag)
+	DBusMessage *msg;
+	dbus_bool_t flag;
+
+int
+dbus_message_get_type(msg)
+	DBusMessage *msg;
+
+const char *
+dbus_message_get_interface(msg)
+	DBusMessage *msg;
+
+const char *
+dbus_message_get_path(msg)
+	DBusMessage *msg;
+
+const char *
+dbus_message_get_destination(msg)
+	DBusMessage *msg;
+
+const char *
+dbus_message_get_sender(msg)
+	DBusMessage *msg;
+
+dbus_uint32_t
+dbus_message_get_serial(msg)
+	DBusMessage *msg;
+
+const char *
+dbus_message_get_member(msg)
+	DBusMessage *msg;
+
+const char *
+dbus_message_get_error_name(msg)
+	DBusMessage *msg;
+
+const char *
+dbus_message_get_signature(msg)
+	DBusMessage *msg;
+
+void
+dbus_message_set_sender(msg, sender);
+	DBusMessage *msg;
+	const char *sender;
+
+void
+dbus_message_set_destination(msg, dest);
+	DBusMessage *msg;
+	const char *dest;
+
+MODULE = Net::DBus::Binding::Message::Signal		PACKAGE = Net::DBus::Binding::Message::Signal
+
+PROTOTYPES: ENABLE
+
+DBusMessage *
+_create(path, interface, name)
+	char *path;
+	char *interface;
+	char *name;
+    PREINIT:
+	DBusMessage *msg;
+    CODE:
+	msg = dbus_message_new_signal(path, interface, name);
+	if (!msg) {
+	  croak("No memory to allocate message");
+	}
+	PD_DEBUG("Create msg new signal %p\n", msg);
+	PD_DEBUG("  Type %d\n", dbus_message_get_type(msg));
+	PD_DEBUG("  Interface %s\n", dbus_message_get_interface(msg) ? dbus_message_get_interface(msg) : "");
+	PD_DEBUG("  Path %s\n", dbus_message_get_path(msg) ? dbus_message_get_path(msg) : "");
+	PD_DEBUG("  Member %s\n", dbus_message_get_member(msg) ? dbus_message_get_member(msg) : "");
+	RETVAL = msg;
+    OUTPUT:
+	RETVAL
+
+MODULE = Net::DBus::Binding::Message::MethodCall		PACKAGE = Net::DBus::Binding::Message::MethodCall
+
+PROTOTYPES: ENABLE
+
+DBusMessage *
+_create(service, path, interface, method)
+	char *service;
+	char *path;
+	char *interface;
+	char *method;
+    PREINIT:
+	DBusMessage *msg;
+    CODE:
+	msg = dbus_message_new_method_call(service, path, interface, method);
+	if (!msg) {
+	  croak("No memory to allocate message");
+	}
+	PD_DEBUG("Create msg new method call %p\n", msg);
+	PD_DEBUG("  Type %d\n", dbus_message_get_type(msg));
+	PD_DEBUG("  Interface %s\n", dbus_message_get_interface(msg) ? dbus_message_get_interface(msg) : "");
+	PD_DEBUG("  Path %s\n", dbus_message_get_path(msg) ? dbus_message_get_path(msg) : "");
+	PD_DEBUG("  Member %s\n", dbus_message_get_member(msg) ? dbus_message_get_member(msg) : "");
+	RETVAL = msg;
+    OUTPUT:
+	RETVAL
+
+MODULE = Net::DBus::Binding::Message::MethodReturn		PACKAGE = Net::DBus::Binding::Message::MethodReturn
+
+PROTOTYPES: ENABLE
+
+DBusMessage *
+_create(call)
+	DBusMessage *call;
+    PREINIT:
+	DBusMessage *msg;
+    CODE:
+	msg = dbus_message_new_method_return(call);
+	if (!msg) {
+	  croak("No memory to allocate message");
+	}
+	dbus_message_set_interface(msg, dbus_message_get_interface(call));
+	dbus_message_set_path(msg, dbus_message_get_path(call));
+	dbus_message_set_member(msg, dbus_message_get_member(call));
+	PD_DEBUG("Create msg new method return %p\n", msg);
+	PD_DEBUG("  Type %d\n", dbus_message_get_type(msg));
+	PD_DEBUG("  Interface %s\n", dbus_message_get_interface(msg) ? dbus_message_get_interface(msg) : "");
+	PD_DEBUG("  Path %s\n", dbus_message_get_path(msg) ? dbus_message_get_path(msg) : "");
+	PD_DEBUG("  Member %s\n", dbus_message_get_member(msg) ? dbus_message_get_member(msg) : "");
+	RETVAL = msg;
+    OUTPUT:
+	RETVAL
+
+MODULE = Net::DBus::Binding::Message::Error		PACKAGE = Net::DBus::Binding::Message::Error
+
+PROTOTYPES: ENABLE
+
+DBusMessage *
+_create(replyto, name, message)
+	DBusMessage *replyto;
+	char *name;
+	char *message;
+    PREINIT:
+	DBusMessage *msg;
+    CODE:
+	msg = dbus_message_new_error(replyto, name, message);
+	if (!msg) {
+	  croak("No memory to allocate message");
+	}
+	PD_DEBUG("Create msg new error %p\n", msg);
+	PD_DEBUG("  Type %d\n", dbus_message_get_type(msg));
+	PD_DEBUG("  Interface %s\n", dbus_message_get_interface(msg) ? dbus_message_get_interface(msg) : "");
+	PD_DEBUG("  Path %s\n", dbus_message_get_path(msg) ? dbus_message_get_path(msg) : "");
+	PD_DEBUG("  Member %s\n", dbus_message_get_member(msg) ? dbus_message_get_member(msg) : "");
+	RETVAL = msg;
+    OUTPUT:
+	RETVAL
+
+MODULE = Net::DBus::Binding::C::PendingCall		PACKAGE = Net::DBus::Binding::C::PendingCall
+
+PROTOTYPES: ENABLE
+
+DBusMessage *
+dbus_pending_call_steal_reply(call)
+	DBusPendingCall *call;
+
+void
+dbus_pending_call_block(call)
+	DBusPendingCall *call;
+
+dbus_bool_t
+dbus_pending_call_get_completed(call)
+	DBusPendingCall *call;
+
+void
+dbus_pending_call_cancel(call)
+	DBusPendingCall *call;
+
+void
+_set_notify(call, code)
+	DBusPendingCall *call;
+	SV *code;
+    CODE:
+	SvREFCNT_inc(code);
+	PD_DEBUG("Adding pending call notify %p\n", code);
+	dbus_pending_call_set_notify(call, _pending_call_callback, code, _pending_call_notify_release);
+
+void
+DESTROY (call)
+	DBusPendingCall *call;
+    CODE:
+	PD_DEBUG("Unrefing pending call %p", call);
+	dbus_pending_call_unref(call);
+
+MODULE = Net::DBus::Binding::C::Watch			PACKAGE = Net::DBus::Binding::C::Watch
+
+int
+get_fileno(watch)
+	DBusWatch *watch;
+    CODE:
+	RETVAL = dbus_watch_get_fd(watch);
+    OUTPUT:
+	RETVAL
+
+unsigned int
+get_flags(watch)
+	DBusWatch *watch;
+    CODE:
+	RETVAL = dbus_watch_get_flags(watch);
+    OUTPUT:
+	RETVAL
+
+dbus_bool_t
+is_enabled(watch)
+	DBusWatch *watch;
+    CODE:
+	RETVAL = dbus_watch_get_enabled(watch);
+    OUTPUT:
+	RETVAL
+
+void
+handle(watch, flags)
+	DBusWatch *watch;
+	unsigned int flags;
+    CODE:
+	PD_DEBUG("Handling event %d on fd %d (%p)\n", flags, dbus_watch_get_fd(watch), watch);
+	dbus_watch_handle(watch, flags);
+
+
+void *
+get_data(watch)
+	DBusWatch *watch;
+    CODE:
+	RETVAL = dbus_watch_get_data(watch);
+    OUTPUT:
+	RETVAL
+
+void
+set_data(watch, data)
+	DBusWatch *watch;
+	void *data;
+    CODE:
+	dbus_watch_set_data(watch, data, NULL);
+
+
+MODULE = Net::DBus::Binding::C::Timeout			PACKAGE = Net::DBus::Binding::C::Timeout
+
+int
+get_interval(timeout)
+	DBusTimeout *timeout;
+    CODE:
+	RETVAL = dbus_timeout_get_interval(timeout);
+    OUTPUT:
+	RETVAL
+
+dbus_bool_t
+is_enabled(timeout)
+	DBusTimeout *timeout;
+    CODE:
+	RETVAL = dbus_timeout_get_enabled(timeout);
+    OUTPUT:
+	RETVAL
+
+void
+handle(timeout)
+	DBusTimeout *timeout;
+    CODE:
+	PD_DEBUG("Handling timeout event %p\n", timeout);
+	dbus_timeout_handle(timeout);
+
+void *
+get_data(timeout)
+	DBusTimeout *timeout;
+    CODE:
+	RETVAL = dbus_timeout_get_data(timeout);
+    OUTPUT:
+	RETVAL
+
+void
+set_data(timeout, data)
+	DBusTimeout *timeout;
+	void *data;
+    CODE:
+	dbus_timeout_set_data(timeout, data, NULL);
+
+MODULE = Net::DBus::Binding::Iterator PACKAGE = Net::DBus::Binding::Iterator
+
+DBusMessageIter *
+_recurse(iter)
+	DBusMessageIter *iter;
+    CODE:
+	RETVAL = dbus_new(DBusMessageIter, 1);
+	dbus_message_iter_recurse(iter, RETVAL);
+    OUTPUT:
+	RETVAL
+
+DBusMessageIter *
+_open_container(iter, type, sig)
+	DBusMessageIter *iter;
+	int type;
+	char *sig;
+    CODE:
+	RETVAL = dbus_new(DBusMessageIter, 1);
+	dbus_message_iter_open_container(iter, type, sig, RETVAL);
+    OUTPUT:
+	RETVAL
+
+void
+_close_container(iter, sub_iter)
+	DBusMessageIter *iter;
+	DBusMessageIter *sub_iter;
+    CODE:
+	dbus_message_iter_close_container(iter, sub_iter);
+
+int
+get_arg_type(iter)
+	DBusMessageIter *iter;
+    CODE:
+	RETVAL = dbus_message_iter_get_arg_type(iter);
+    OUTPUT:
+	RETVAL
+
+int
+get_element_type(iter)
+	DBusMessageIter *iter;
+    CODE:
+	RETVAL = dbus_message_iter_get_element_type(iter);
+    OUTPUT:
+	RETVAL
+
+dbus_bool_t
+has_next(iter)
+	DBusMessageIter *iter;
+    CODE:
+	RETVAL = dbus_message_iter_has_next(iter);
+    OUTPUT:
+	RETVAL
+
+dbus_bool_t
+next(iter)
+	DBusMessageIter *iter;
+    CODE:
+	RETVAL = dbus_message_iter_next(iter);
+    OUTPUT:
+	RETVAL
+
+dbus_bool_t
+get_boolean(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+unsigned char
+get_byte(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+dbus_int16_t
+get_int16(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+dbus_uint16_t
+get_uint16(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+dbus_int32_t
+get_int32(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+dbus_uint32_t
+get_uint32(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+dbus_int64_t
+_get_int64(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+dbus_uint64_t
+_get_uint64(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+double
+get_double(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+char *
+get_string(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+char *
+get_signature(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+char *
+get_object_path(iter)
+	DBusMessageIter *iter;
+    CODE:
+	dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+	RETVAL
+
+
+void
+append_boolean(iter, val)
+	DBusMessageIter *iter;
+	dbus_bool_t val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_BOOLEAN, &val)) {
+	  croak("cannot append boolean");
+	}
+
+void
+append_byte(iter, val)
+	DBusMessageIter *iter;
+	unsigned char val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_BYTE, &val)) {
+	  croak("cannot append byte");
+	}
+
+void
+append_int16(iter, val)
+	DBusMessageIter *iter;
+	dbus_int16_t val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_INT16, &val)) {
+	  croak("cannot append int16");
+	}
+
+void
+append_uint16(iter, val)
+	DBusMessageIter *iter;
+	dbus_uint16_t val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_UINT16, &val)) {
+	  croak("cannot append uint16");
+	}
+
+void
+append_int32(iter, val)
+	DBusMessageIter *iter;
+	dbus_int32_t val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_INT32, &val)) {
+	  croak("cannot append int32");
+	}
+
+void
+append_uint32(iter, val)
+	DBusMessageIter *iter;
+	dbus_uint32_t val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_UINT32, &val)) {
+	  croak("cannot append uint32");
+	}
+
+void
+_append_int64(iter, val)
+	DBusMessageIter *iter;
+	dbus_int64_t val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_INT64, &val)) {
+	  croak("cannot append int64");
+	}
+
+void
+_append_uint64(iter, val)
+	DBusMessageIter *iter;
+	dbus_uint64_t val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_UINT64, &val)) {
+	  croak("cannot append uint64");
+	}
+
+void
+append_double(iter, val)
+	DBusMessageIter *iter;
+	double val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_DOUBLE, &val)) {
+	  croak("cannot append double");
+	}
+
+void
+append_string(iter, val)
+	DBusMessageIter *iter;
+	char *val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_STRING, &val)) {
+	  croak("cannot append string");
+	}
+
+void
+append_object_path(iter, val)
+	DBusMessageIter *iter;
+	char *val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_OBJECT_PATH, &val)) {
+	  croak("cannot append object path");
+	}
+
+void
+append_signature(iter, val)
+	DBusMessageIter *iter;
+	char *val;
+    CODE:
+	if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_SIGNATURE, &val)) {
+	  croak("cannot append signature");
+	}
+
+
+
+void
+DESTROY(iter)
+	DBusMessageIter *iter;
+    CODE:
+	PD_DEBUG("Destroying iterator %p\n", iter);
+	dbus_free(iter);
+
+MODULE = Net::DBus		PACKAGE = Net::DBus
diff --git a/Net-DBus/Makefile.PL b/Net-DBus/Makefile.PL
new file mode 100644
index 0000000..2f1cb9e
--- /dev/null
+++ b/Net-DBus/Makefile.PL
@@ -0,0 +1,69 @@
+use 5.006;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+my $DBUS_LIBS = `pkg-config --libs dbus-1`;
+my $DBUS_CFLAGS = `pkg-config --cflags dbus-1`;
+
+if (!defined $DBUS_LIBS || !defined DBUS_CFLAGS) {
+    die "could not run 'pkg-config' to determine compiler/linker flags for dbus library: $!\n";
+}
+if (!$DBUS_LIBS || !$DBUS_CFLAGS) {
+    die "'pkg-config' didn't report any compiler/linker flags for dbus library\n";
+}
+
+WriteMakefile(
+	      'NAME' => 'Net::DBus',
+	      'MAKEFILE' => 'Makefile.perl',
+	      'VERSION_FROM' => 'lib/Net/DBus.pm',
+	      'PREREQ_PM' => {
+		  'Test::More'  => 0,
+		  'Time::HiRes' => 0,
+		  'XML::Twig' => 0,
+		  },
+#    'ABSTRACT_FROM' => 'lib/Net/DBus.pm',
+	      'AUTHOR' => 'Daniel Berrange <dan@berrange.com>',
+	      'LIBS' => [$DBUS_LIBS], 
+	      'DEFINE' => "-DDBUS_API_SUBJECT_TO_CHANGE -DPD_DO_DEBUG=1",
+	      'INC' => "-Wall $DBUS_CFLAGS",
+	      'depend' => {
+		  Net-DBus.spec => '$(VERSION_FROM)',
+		  Makefile => '$(VERSION_FROM)',
+	      },
+	      'realclean' => {
+		  FILES => 'Net-DBus.spec',
+	      },
+);
+
+package MY;
+
+sub libscan
+  {
+    my ($self, $path) = @_;
+    ($path =~ /\~$/ || $path =~ m,/CVS/,) ? undef : $path;
+  }
+
+sub test {
+    my $self = shift;
+    my $mm_test = $self->SUPER::test(@_);
+    
+    return '
+TO_TEST_PM = $(TO_INST_PM:lib/%.pm=blib/test/%.pm.tstamp)
+
+test :: test-syntax
+
+test-syntax: pure_all $(TO_TEST_PM)
+
+blib/test/%.pm.tstamp: lib/%.pm
+	@echo -n "Checking $<: "
+	#@perl -I blib/lib -c $<
+	@podchecker $<
+	@mkdir -p `dirname $@`
+	@touch $@
+
+' . $mm_test;
+  }
+
+
+__END__
diff --git a/Net-DBus/Makefile.am b/Net-DBus/Makefile.am
new file mode 100644
index 0000000..46fd251
--- /dev/null
+++ b/Net-DBus/Makefile.am
@@ -0,0 +1,55 @@
+SUBDIRS = lib
+
+EXTRA_DIST = Makefile.PL DBus.xs
+
+INCLUDES = -I$(top_srcdir)
+
+AM_CPPFLAGS=@CPPFLAGS@ -I$(top_srcdir) -I$(top_builddir) @DBUS_CFLAGS@
+AM_CFLAGS=@CFLAGS@ @DBUS_CFLAGS@
+AM_STANDARD_CFLAGS=@DBUS_CFLAGS@
+
+PERL=@PERL_PATH@
+
+PERL_MAKEFILE=Makefile.perl
+
+PERL_CRUFT=pm_to_blib $(PERL_MAKEFILE).old
+
+fakedir=$(prefix)
+fake_DATA=build-perl-stamp
+
+$(PERL_MAKEFILE): DBus.xs
+	test -e Makefile.PL || $(LN_S) $(srcdir)/Makefile.PL .
+	VERSION=$(VERSION) CC=$(CC) CFLAGS="$(AM_CPPFLAGS) $(AM_CFLAGS) $(SWIG_OPTS) $(CPPFLAGS) $(AM_STANDARD_CFLAGS)" $(PERL) $(srcdir)/Makefile.PL DESTDIR=$(DESTDIR) PREFIX=$(prefix) $(MAKE_PL_OPTS)
+
+-perl install-perl: $(PERL_MAKEFILE)
+	target=`echo $@ | sed -e 's/-perl//'`; \
+	$(MAKE) -f $(PERL_MAKEFILE) DESTDIR=$(DESTDIR) PREFIX=$(prefix) $$target
+
+test-perl: $(PERL_MAKEFILE)
+	$(RUN)$(MAKE) -f $(PERL_MAKEFILE) test
+
+clean-perl realclean-perl:
+	@target=`echo $@ | sed -e 's/-perl//'`; \
+	if test -r $(PERL_MAKEFILE); then \
+	  echo $(MAKE) -f $(PERL_MAKEFILE) $$target; \
+	  $(MAKE) -f $(PERL_MAKEFILE) $$target; \
+	fi
+
+build-perl: -perl
+
+build-perl-stamp:
+	$(MAKE) build-perl && touch build-perl-stamp
+
+clean-local:
+	rm -f DBus.bs  DBus.c  DBus.o
+	rm -rf blib $(PERL_MAKEFILE) $(PERL_MAKEFILE).old build-perl-stamp $(PERL_CRUFT)
+	-test -L Makefile.PL && rm Makefile.PL
+
+
+# perl module installation disabled since broken wrt to make distcheck
+install-fakeDATA: install-perl
+
+uninstall-local:
+	find $(DESTDIR)$(prefix) -name perllocal.pod -exec rm -f {} \;
+	true
+
diff --git a/Net-DBus/lib/Makefile.am b/Net-DBus/lib/Makefile.am
new file mode 100644
index 0000000..adf3f84
--- /dev/null
+++ b/Net-DBus/lib/Makefile.am
@@ -0,0 +1 @@
+SUBDIRS = Net
diff --git a/Net-DBus/lib/Net/DBus.pm b/Net-DBus/lib/Net/DBus.pm
new file mode 100644
index 0000000..0de90ae
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus.pm
@@ -0,0 +1,739 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus - Perl extension for the DBus message system
+
+=head1 SYNOPSIS
+
+
+  ####### Attaching to the bus ###########
+
+  use Net::DBus;
+
+  # Find the most appropriate bus
+  my $bus = Net::DBus->find;
+
+  # ... or explicitly go for the session bus
+  my $bus = Net::DBus->session;
+
+  # .... or explicitly go for the system bus
+  my $bus = Net::DBus->system
+
+
+  ######## Accessing remote services #########
+
+  # Get a handle to the HAL service
+  my $hal = $bus->get_service("org.freedesktop.Hal");
+
+  # Get the device manager
+  my $manager = $hal->get_object("/org/freedesktop/Hal/Manager",
+				 "org.freedesktop.Hal.Manager");
+
+  # List devices
+  foreach my $dev (@{$manager->GetAllDevices}) {
+      print $dev, "\n";
+  }
+
+
+  ######### Providing services ##############
+
+  # Register a service known as 'org.example.Jukebox'
+  my $service = $bus->export_service("org.example.Jukebox");
+
+
+=head1 DESCRIPTION
+
+Net::DBus provides a Perl API for the DBus message system.
+The DBus Perl interface is currently operating against
+the 0.32 development version of DBus, but should work with
+later versions too, providing the API changes have not been
+too drastic.
+
+Users of this package are either typically, service providers
+in which case the L<Net::DBus::Service> and L<Net::DBus::Object>
+modules are of most relevance, or are client consumers, in which
+case L<Net::DBus::RemoteService> and L<Net::DBus::RemoteObject>
+are of most relevance.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus;
+
+use 5.006;
+use strict;
+use warnings;
+
+BEGIN {
+    our $VERSION = '0.33.3';
+    require XSLoader;
+    XSLoader::load('Net::DBus', $VERSION);
+}
+
+use Net::DBus::Binding::Bus;
+use Net::DBus::Service;
+use Net::DBus::RemoteService;
+use Net::DBus::Test::MockConnection;
+use Net::DBus::Binding::Value;
+
+use vars qw($bus_system $bus_session);
+
+use Exporter qw(import);
+
+use vars qw(@EXPORT_OK %EXPORT_TAGS);
+
+@EXPORT_OK = qw(dbus_int16 dbus_uint16 dbus_int32 dbus_uint32 dbus_int64 dbus_uint64
+		dbus_byte dbus_boolean dbus_string dbus_double
+		dbus_object_path dbus_signature
+		dbus_struct dbus_array dbus_dict dbus_variant);
+
+%EXPORT_TAGS = (typing => [qw(dbus_int16 dbus_uint16 dbus_int32 dbus_uint32 dbus_int64 dbus_uint64
+			      dbus_byte dbus_boolean dbus_string dbus_double
+			      dbus_object_path dbus_signature
+			      dbus_struct dbus_array dbus_dict dbus_variant)]);
+
+=item my $bus = Net::DBus->find(%params);
+
+Search for the most appropriate bus to connect to and
+return a connection to it. The heuristic used for the
+search is
+
+  - If DBUS_STARTER_BUS_TYPE is set to 'session' attach
+    to the session bus
+
+  - Else If DBUS_STARTER_BUS_TYPE is set to 'system' attach
+    to the system bus
+
+  - Else If DBUS_SESSION_BUS_ADDRESS is set attach to the
+    session bus
+
+  - Else attach to the system bus
+
+The optional C<params> hash can contain be used to specify
+connection options. The only support option at this time
+is C<nomainloop> which prevents the bus from being automatically
+attached to the main L<Net::DBus::Reactor> event loop.
+
+=cut
+
+sub find {
+    my $class = shift;
+
+    if ($ENV{DBUS_STARTER_BUS_TYPE} &&
+	$ENV{DBUS_STARTER_BUS_TYPE} eq "session") {
+	return $class->session(@_);
+    } elsif ($ENV{DBUS_STARTER_BUS_TYPE} &&
+	     $ENV{DBUS_STARTER_BUS_TYPE} eq "system") {
+	return $class->system(@_);
+    } elsif (exists $ENV{DBUS_SESSION_BUS_ADDRESS}) {
+	return $class->session(@_);
+    } else {
+	return $class->system;
+    }
+}
+
+=item my $bus = Net::DBus->system(%params);
+
+Return a handle for the system message bus. Note that the
+system message bus is locked down by default, so unless appropriate
+access control rules are added in /etc/dbus/system.d/, an application
+may access services, but won't be able to export services.
+The optional C<params> hash can contain be used to specify
+connection options. The only support option at this time
+is C<nomainloop> which prevents the bus from being automatically
+attached to the main L<Net::DBus::Reactor> event loop.
+
+=cut
+
+sub system {
+    my $class = shift;
+    unless ($bus_system) {
+	$bus_system = $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SYSTEM), @_);
+    }
+    return $bus_system
+}
+
+=item my $bus = Net::DBus->session(%params);
+
+Return a handle for the session message bus.
+The optional C<params> hash can contain be used to specify
+connection options. The only support option at this time
+is C<nomainloop> which prevents the bus from being automatically
+attached to the main L<Net::DBus::Reactor> event loop.
+
+=cut
+
+sub session {
+    my $class = shift;
+    unless ($bus_session) {
+	$bus_session = $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SESSION), @_);
+    }
+    return $bus_session;
+}
+
+
+=item my $bus = Net::DBus->test(%params);
+
+Returns a handle for a virtual bus for use in unit tests. This bus does
+not make any network connections, but rather has an in-memory message
+pipeline. Consult L<Net::DBus::Test::MockConnection> for further details
+of how to use this special bus.
+
+=cut
+
+# NB. explicitly do *NOT* cache, since unit tests
+# should always have pristine state
+sub test {
+    my $class = shift;
+    return $class->_new(Net::DBus::Test::MockConnection->new());
+}
+
+=item my $bus = Net::DBus->new($address, %params);
+
+Return a connection to a specific message bus.  The C<$address>
+parameter must contain the address of the message bus to connect
+to. An example address for a session bus might look like
+C<unix:abstract=/tmp/dbus-PBFyyuUiVb,guid=191e0a43c3efc222e0818be556d67500>,
+while one for a system bus would look like C<unix:/var/run/dbus/system_bus_socket>.
+The optional C<params> hash can contain be used to specify
+connection options. The only support option at this time
+is C<nomainloop> which prevents the bus from being automatically
+attached to the main L<Net::DBus::Reactor> event loop.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $nomainloop = shift;
+    return $class->_new(Net::DBus::Binding::Bus->new(address => shift), @_);
+}
+
+sub _new {
+    my $class = shift;
+    my $self = {};
+
+    $self->{connection} = shift;
+    $self->{signals} = [];
+    $self->{services} = {};
+
+    my %params = @_;
+
+    bless $self, $class;
+
+    unless ($params{nomainloop}) {
+	if (exists $INC{'Net/DBus/Reactor.pm'}) {
+	    my $reactor = Net::DBus::Reactor->main;
+	    $reactor->manage($self->get_connection);
+	}
+	# ... Add support for GLib and POE
+    }
+
+    $self->get_connection->add_filter(sub { $self->_signal_func(@_) });
+
+    # XXX is it ok to fix '1:0' as the owner of this ?
+    $self->{bus} = Net::DBus::RemoteService->new($self, ":1.0", "org.freedesktop.DBus");
+
+    return $self;
+}
+
+=item my $connection = $bus->get_connection;
+
+Return a handle to the underlying, low level connection object
+associated with this bus. The returned object will be an instance
+of the L<Net::DBus::Binding::Bus> class. This method is not intended
+for use by (most!) application developers, so if you don't understand
+what this is for, then you don't need to be calling it!
+
+=cut
+
+sub get_connection {
+    my $self = shift;
+    return $self->{connection};
+}
+
+=item my $service = $bus->get_service($name);
+
+Retrieves a handle for the remote service identified by the
+service name C<$name>. The returned object will be an instance
+of the L<Net::DBus::RemoteService> class.
+
+=cut
+
+sub get_service {
+    my $self = shift;
+    my $name = shift;
+
+    if ($name eq "org.freedesktop.DBus") {
+	return $self->{bus};
+    }
+
+    my $owner = $name;
+    if ($owner !~ /^:/) {
+	$owner = $self->get_service_owner($name);
+	if (!$owner) {
+	    $self->get_bus_object->StartServiceByName($name, 0);
+	    $owner = $self->get_service_owner($name);
+	}
+    }
+
+    unless (exists $self->{services}->{$owner}) {
+	$self->{services}->{$owner} = Net::DBus::RemoteService->new($self, $owner, $name);
+    }
+    return $self->{services}->{$owner};
+}
+
+=item my $service = $bus->export_service($name);
+
+Registers a service with the bus, returning a handle to
+the service. The returned object is an instance of the
+L<Net::DBus::Service> class.
+
+=cut
+
+sub export_service {
+    my $self = shift;
+    my $name = shift;
+    return Net::DBus::Service->new($self, $name);
+}
+
+=item my $object = $bus->get_bus_object;
+
+Retrieves a handle to the bus object, C</org/freedesktop/DBus>,
+provided by the service C<org.freedesktop.DBus>. The returned
+object is an instance of L<Net::DBus::RemoteObject>
+
+=cut
+
+sub get_bus_object {
+    my $self = shift;
+
+    my $service = $self->get_service("org.freedesktop.DBus");
+    return $service->get_object('/org/freedesktop/DBus',
+				'org.freedesktop.DBus');
+}
+
+
+=item my $name = $bus->get_unique_name;
+
+Retrieves the unique name of this client's connection to
+the bus.
+
+=cut
+
+sub get_unique_name {
+    my $self = shift;
+
+    return $self->get_connection->get_unique_name
+}
+
+=item my $name = $bus->get_service_owner($service);
+
+Retrieves the unique name of the client on the bus owning
+the service named by the C<$service> parameter.
+
+=cut
+
+sub get_service_owner {
+    my $self = shift;
+    my $service = shift;
+
+    my $bus = $self->get_bus_object;
+    my $owner = eval {
+	$bus->GetNameOwner($service);
+    };
+    if ($@) {
+	if (UNIVERSAL::isa($@, "Net::DBus::Error") &&
+	    $@->{name} eq "org.freedesktop.DBus.Error.NameHasNoOwner") {
+	    $owner = undef;
+	} else {
+	    die $@;
+	}
+    }
+    return $owner;
+}
+
+
+sub _add_signal_receiver {
+    my $self = shift;
+    my $receiver = shift;
+    my $signal_name = shift;
+    my $interface = shift;
+    my $service = shift;
+    my $path = shift;
+
+    my $rule = $self->_match_rule($signal_name, $interface, $service, $path);
+
+    push @{$self->{signals}}, [$receiver, $rule, $signal_name, $interface, $service, $path];
+    $self->{connection}->add_match($rule);
+}
+
+sub _remove_signal_receiver {
+    my $self = shift;
+    my $receiver = shift;
+    my $signal_name = shift;
+    my $interface = shift;
+    my $service = shift;
+    my $path = shift;
+
+    my $rule = $self->_match_rule($signal_name, $interface, $service, $path);
+
+    my @signals;
+    foreach (@{$self->{signals}}) {
+	if ($_->[0] eq $receiver &&
+	    defined $_->[1] &&
+	    $_->[1] eq $rule) {
+	    $self->{connection}->remove_match($rule);
+	} else {
+	    push @signals, $_;
+	}
+    }
+    $self->{signals} = \@signals;
+}
+
+
+sub _match_rule {
+    my $self = shift;
+    my $signal_name = shift;
+    my $interface = shift;
+    my $service = shift;
+    my $path = shift;
+
+    my $rule = "type='signal'";
+    if ($interface) {
+	$rule .= ",interface='$interface'";
+    }
+    if ($service) {
+	if ($service !~ /^:/) {
+	    # Resolve service name to a client id
+	    $service = $self->get_service_owner($service);
+	}
+	if ($service) {
+	    $rule .= ",sender='$service'";
+	}
+    }
+    if ($path) {
+	$rule .= ",path='$path'";
+    }
+    if ($signal_name) {
+	$rule .= ",member='$signal_name'";
+    }
+    return $rule;
+}
+
+
+sub _rule_matches {
+    my $self = shift;
+    my $rule = shift;
+    my $member = shift;
+    my $interface = shift;
+    my $sender = shift;
+    my $path = shift;
+
+    my %bits;
+    map {
+	if (/^(\w+)='(.*)'$/) {
+	    $bits{$1} = $2;
+	}
+    } split /,/, $rule;
+
+
+    if (exists $bits{member} &&
+	$bits{member} ne $member) {
+	return 0;
+    }
+    if (exists $bits{interface} &&
+	$bits{interface} ne $interface) {
+	return 0;
+    }
+    if (exists $bits{sender} &&
+	$bits{sender} ne $sender) {
+	return 0;
+    }
+    if (exists $bits{path} &&
+	$bits{path} ne $path) {
+	return 0;
+    }
+    return 1;
+}
+
+sub _signal_func {
+    my $self = shift;
+    my $connection = shift;
+    my $message = shift;
+
+    return 0 unless $message->get_type() == &Net::DBus::Binding::Message::MESSAGE_TYPE_SIGNAL;
+
+    my $interface = $message->get_interface;
+    my $sender = $message->get_sender;
+    my $path = $message->get_path;
+    my $member = $message->get_member;
+
+    my $handled = 0;
+    foreach my $handler (grep { defined $_->[1] &&
+				$self->_rule_matches($_->[1], $member, $interface, $sender, $path) }
+			 @{$self->{signals}}) {
+	my $callback = $handler->[0];
+	&$callback($message);
+	$handled = 1;
+    }
+
+    return $handled;
+}
+
+=back
+
+=head1 DATA TYPING METHODS
+
+These methods are not usually used, since most services provide introspection
+data to inform clients of their data typing requirements. If introspection data
+is incomplete, however, it may be neccessary for a client to mark values with
+specific data types. In such a case, the following methods can be used. They
+are not, however, exported by default so must be requested at import time by
+specifying 'use Net::DBus qw(:typing)'
+
+=over 4
+
+=item $typed_value = dbus_int16($value);
+
+Mark a value as being a signed, 16-bit integer.
+
+=cut
+
+sub dbus_int16 {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_INT16,
+					  $_[0]);
+
+}
+
+=item $typed_value = dbus_uint16($value);
+
+Mark a value as being an unsigned, 16-bit integer.
+
+=cut
+
+
+sub dbus_uint16 {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_UINT16,
+					  $_[0]);
+}
+
+=item $typed_value = dbus_int32($value);
+
+Mark a value as being a signed, 32-bit integer.
+
+=cut
+
+sub dbus_int32 {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_INT32,
+					  $_[0]);
+
+}
+
+=item $typed_value = dbus_uint32($value);
+
+Mark a value as being an unsigned, 32-bit integer.
+
+=cut
+
+
+sub dbus_uint32 {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_UINT32,
+					  $_[0]);
+}
+
+=item $typed_value = dbus_int64($value);
+
+Mark a value as being an unsigned, 64-bit integer.
+
+=cut
+
+
+
+sub dbus_int64 {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_INT64,
+					  $_[0]);
+
+}
+
+=item $typed_value = dbus_uint64($value);
+
+Mark a value as being an unsigned, 64-bit integer.
+
+=cut
+
+
+
+sub dbus_uint64 {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_UINT64,
+					  $_[0]);
+}
+
+=item $typed_value = dbus_double($value);
+
+Mark a value as being a double precision IEEE floating point.
+
+=cut
+
+
+
+sub dbus_double {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_DOUBLE,
+					  $_[0]);
+}
+
+=item $typed_value = dbus_byte($value);
+
+Mark a value as being an unsigned, byte.
+
+=cut
+
+
+
+sub dbus_byte {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_BYTE,
+					  $_[0]);
+}
+
+=item $typed_value = dbus_string($value);
+
+Mark a value as being a UTF-8 string. This is not usually required
+since 'string' is the default data type for any Perl scalar value.
+
+=cut
+
+
+
+sub dbus_string {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_STRING,
+					  $_[0]);
+}
+
+=item $typed_value = dbus_signature($value);
+
+Mark a value as being a UTF-8 string, whose contents is a valid
+type signature
+
+=cut
+
+
+
+sub dbus_signature {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_SIGNATURE,
+					  $_[0]);
+}
+
+=item $typed_value = dbus_object_path($value);
+
+Mark a value as being a UTF-8 string, whose contents is a valid
+object path.
+
+=cut
+
+sub dbus_object_path {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_OBJECT_PATH,
+					  $_[0]);
+}
+
+=item $typed_value = dbus_boolean($value);
+
+Mark a value as being an boolean
+
+=cut
+
+
+
+sub dbus_boolean {
+    return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_BOOLEAN,
+					  $_[0]);
+}
+
+=item $typed_value = dbus_array($value);
+
+Mark a value as being an array
+
+=cut
+
+
+sub dbus_array {
+    return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_ARRAY],
+					  $_[0]);
+}
+
+=item $typed_value = dbus_struct($value);
+
+Mark a value as being a structure
+
+=cut
+
+
+sub dbus_struct {
+    return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_STRUCT],
+					  $_[0]);
+}
+
+=item $typed_value = dbus_dict($value);
+
+Mark a value as being a dictionary
+
+=cut
+
+sub dbus_dict{
+    return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_DICT_ENTRY],
+					  $_[0]);
+}
+
+=item $typed_value = dbus_variant($value);
+
+Mark a value as being a variant
+
+=cut
+
+sub dbus_variant{
+    return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_VARIANT],
+					  $_[0]);
+}
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::RemoteService>, L<Net::DBus::Service>,
+L<Net::DBus::RemoteObject>, L<Net::DBus::Object>,
+L<Net::DBus::Exporter>, L<Net::DBus::Dumper>, L<Net::DBus::Reactor>,
+C<dbus-monitor(1)>, C<dbus-daemon-1(1)>, C<dbus-send(1)>, L<http://dbus.freedesktop.org>,
+
+=head1 AUTHOR
+
+Daniel Berrange <dan@berrange.com>
+
+=head1 COPYRIGHT
+
+Copyright 2004-2005 by Daniel Berrange
+
+=cut
+
+1;
diff --git a/Net-DBus/lib/Net/DBus/ASyncReply.pm b/Net-DBus/lib/Net/DBus/ASyncReply.pm
new file mode 100644
index 0000000..94f6f60
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/ASyncReply.pm
@@ -0,0 +1,185 @@
+# -*- perl -*-
+#
+# Copyright (C) 2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::ASyncReply - asynchronous method reply handler
+
+=head1 SYNOPSIS
+
+  use Net::DBus::Annotation qw(:call);
+
+  my $object = $service->get_object("/org/example/systemMonitor");
+
+  # List processes & get on with other work until
+  # the list is returned.
+  my $asyncreply = $object->list_processes(dbus_call_async, "someuser");
+
+  while (!$asyncreply->is_ready) {
+    ... do some background work..
+  }
+
+  my $processes = $asyncreply->get_result;
+
+
+=head1 DESCRIPTION
+
+This object provides a handler for receiving asynchronous
+method replies. An asynchronous reply object is generated
+when making remote method call with the C<dbus_call_async>
+annotation set.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::ASyncReply;
+
+use strict;
+use warnings;
+
+
+sub _new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $self = {};
+    my %params = @_;
+
+    $self->{pending_call} = $params{pending_call} ? $params{pending_call} : die "pending_call parameter is required";
+    $self->{introspector} = $params{introspector} ? $params{introspector} : undef;
+    $self->{method_name} = $params{method_name} ? $params{method_name} : ($self->{introspector} ? die "method_name is parameter required for introspection" : undef);
+
+    bless $self, $class;
+
+    return $self;
+}
+
+
+=item $asyncreply->discard_result;
+
+Indicates that the caller is no longer interested in
+recieving the reply & that it should be discarded. After
+calling this method, this object should not be used again.
+
+=cut
+
+sub discard_result {
+    my $self = shift;
+
+    $self->{pending_call}->cancel;
+}
+
+
+=item $asyncreply->wait_for_result;
+
+Blocks the caller waiting for completion of the of the
+asynchronous reply. Upon returning from this method, the
+result can be obtained with the C<get_result> method.
+
+=cut
+
+sub wait_for_result {
+    my $self = shift;
+
+    $self->{pending_call}->block;
+}
+
+=item my $boolean = $asyncreply->is_ready;
+
+Returns a true value if the asynchronous reply is now
+complete (or a timeout has occurred). When this method
+returns true, the result can be obtained with the C<get_result>
+method.
+
+=cut
+
+sub is_ready {
+    my $self = shift;
+
+    return $self->{pending_call}->get_completed;
+}
+
+
+=item $asyncreply->set_notify($coderef);
+
+Sets a notify function which will be invoked when the
+asynchronous reply finally completes. The callback will
+be invoked with a single parameter which is this object.
+
+=cut
+
+sub set_notify {
+    my $self = shift;
+    my $cb = shift;
+
+    $self->{pending_call}->set_notify(sub {
+	my $pending_call = shift;
+
+	&$cb($self);
+    });
+}
+
+=item my @data = $asyncreply->get_result;
+
+Retrieves the data associated with the asynchronous reply.
+If a timeout occurred, then this method will throw an
+exception. This method can only be called once the reply
+is complete, as indicated by the C<is_ready> method
+returning a true value. After calling this method, this
+object should no longer be used.
+
+=cut
+
+sub get_result {
+    my $self = shift;
+
+    my $reply = $self->{pending_call}->get_reply;
+
+    my @reply;
+    if ($self->{introspector}) {
+	@reply = $self->{introspector}->decode($reply, "methods", $self->{method_name}, "returns");
+    } else {
+	@reply = $reply->get_args_list;
+    }
+
+    return wantarray ? @reply : $reply[0];
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 AUTHOR
+
+Daniel Berrange <dan@berrange.com>
+
+=head1 COPYRIGHT
+
+Copright (C) 2006, Daniel Berrange.
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::RemoteObject>, L<Net::DBus::Annotation>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Annotation.pm b/Net-DBus/lib/Net/DBus/Annotation.pm
new file mode 100644
index 0000000..def26d0
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Annotation.pm
@@ -0,0 +1,131 @@
+# -*- perl -*-
+#
+# Copyright (C) 2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Annotation - annotations for changing behaviour of APIs
+
+=head1 SYNOPSIS
+
+  use Net::DBus::Annotation qw(:call);
+
+  my $object = $service->get_object("/org/example/systemMonitor");
+
+  # Block until processes are listed
+  my $processes = $object->list_processes("someuser");
+
+  # Just throw away list of processes, pretty pointless
+  # in this example, but useful if the method doesn't have
+  # a return value
+  $object->list_processes(dbus_call_noreply, "someuser");
+
+  # List processes & get on with other work until
+  # the list is returned.
+  my $asyncreply = $object->list_processes(dbus_call_async, "someuser");
+
+  ... some time later...
+  my $processes = $asyncreply->get_data;
+
+=head1 DESCRIPTION
+
+This module provides a number of annotations which will be useful
+when dealing with the DBus APIs. There are annotations for switching
+remote calls between sync, async and no-reply mode. More annotations
+may be added over time.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Annotation;
+
+use strict;
+use warnings;
+
+our $CALL_SYNC = "sync";
+our $CALL_ASYNC = "async";
+our $CALL_NOREPLY = "noreply";
+
+bless \$CALL_SYNC, __PACKAGE__;
+bless \$CALL_ASYNC, __PACKAGE__;
+bless \$CALL_NOREPLY, __PACKAGE__;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(dbus_call_sync dbus_call_async dbus_call_noreply);
+our %EXPORT_TAGS = (call => [qw(dbus_call_sync dbus_call_async dbus_call_noreply)]);
+
+=item dbus_call_sync
+
+Requests that a method call be performed synchronously, waiting
+for the reply or error return to be received before continuing.
+
+=cut
+
+sub dbus_call_sync() {
+    return \$CALL_SYNC;
+}
+
+
+=item dbus_call_async
+
+Requests that a method call be performed a-synchronously, returning
+a pending call object, which will collect the reply when it eventually
+arrives.
+
+=cut
+
+sub dbus_call_async() {
+    return \$CALL_ASYNC;
+}
+
+=item dbus_call_noreply
+
+Requests that a method call be performed a-synchronously, discarding
+any possible reply or error message.
+
+=cut
+
+sub dbus_call_noreply() {
+    return \$CALL_NOREPLY;
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 AUTHOR
+
+Daniel Berrange <dan@berrange.com>
+
+=head1 COPYRIGHT
+
+Copright (C) 2006, Daniel Berrange.
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::RemoteObject>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Bus.pm b/Net-DBus/lib/Net/DBus/Binding/Bus.pm
new file mode 100644
index 0000000..0dfa075
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Bus.pm
@@ -0,0 +1,191 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Bus - Handle to a well-known message bus instance
+
+=head1 SYNOPSIS
+
+  use Net::DBus::Binding::Bus;
+
+  # Get a handle to the system bus
+  my $bus = Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SYSTEM);
+
+=head1 DESCRIPTION
+
+This is a specialization of the L<Net::DBus::Binding::Connection>
+module providing convenience constructor for connecting to one of
+the well-known bus types. There is no reason to use this module
+directly, instead get a handle to the bus with the C<session> or
+C<system> methods in L<Net::DBus>.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::Bus;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+
+use base qw(Net::DBus::Binding::Connection);
+
+=item my $bus = Net::DBus::Binding::Bus->new(type => $type);
+
+=item my $bus = Net::DBus::Binding::Bus->new(address => $addr);
+
+Open a connection to a message bus, either a well known bus type
+specified using the C<type> parameter, or an arbitrary bus specified
+using the C<address> parameter.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+    
+    my $connection;
+    if (defined $params{type}) {
+	$connection = Net::DBus::Binding::Bus::_open($params{type});
+    } elsif (defined $params{address}) {
+	$connection = Net::DBus::Binding::Connection::_open($params{address});
+	$connection->dbus_bus_register();
+    } else {
+	die "either type or address parameter is required";
+    }
+	  
+    my $self = $class->SUPER::new(%params, connection => $connection);
+
+    bless $self, $class;
+
+    return $self;
+}
+
+
+=item $bus->request_name($service_name)
+
+Send a request to the bus registering the well known name 
+specified in the C<$service_name> parameter. If another client
+already owns the name, registration will be queued up, pending
+the exit of the other client.
+
+=cut
+
+sub request_name {
+    my $self = shift;
+    my $service_name = shift;
+    
+    $self->{connection}->dbus_bus_request_name($service_name);
+}
+
+=item my $name = $bus->get_unique_name
+
+Returns the unique name by which this processes' connection to
+the bus is known. Unique names are never re-used for the entire
+lifetime of the bus daemon.
+
+=cut
+
+sub get_unique_name {
+    my $self = shift;
+
+    $self->{connection}->dbus_bus_get_unique_name;
+}
+
+
+=item $bus->add_match($rule)
+
+Register a signal match rule with the bus controller, allowing
+matching broadcast signals to routed to this client.
+
+=cut
+
+sub add_match {
+    my $self = shift;
+    my $rule = shift;
+    
+    $self->{connection}->dbus_bus_add_match($rule);
+}
+
+=item $bus->remove_match($rule)
+
+Unregister a signal match rule with the bus controller, preventing
+further broadcast signals being routed to this client
+
+=cut
+
+sub remove_match {
+    my $self = shift;
+    my $rule = shift;
+    
+    $self->{connection}->dbus_bus_remove_match($rule);
+}
+
+sub DESTROY {
+    # Keep autoloader quiet
+}
+
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.
+
+    my $constname;
+    our $AUTOLOAD;
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+
+    die "&Net::DBus::Binding::Bus::constant not defined" if $constname eq '_constant';
+
+    if (!exists $Net::DBus::Binding::Bus::_constants{$constname}) {
+        die "no such method $constname, and no constant \$Net::DBus::Binding::Bus::$constname";
+    }
+
+    {
+	no strict 'refs';
+	*$AUTOLOAD = sub { $Net::DBus::Binding::Bus::_constants{$constname} };
+    }
+    goto &$AUTOLOAD;
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Connection>, L<Net::DBus>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan@berrange.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004-2005 by Daniel Berrange
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Connection.pm b/Net-DBus/lib/Net/DBus/Binding/Connection.pm
new file mode 100644
index 0000000..513ce24
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Connection.pm
@@ -0,0 +1,646 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Connection - A connection between client and server
+
+=head1 SYNOPSIS
+
+Creating a connection to a server and sending a message
+
+  use Net::DBus::Binding::Connection;
+
+  my $con = Net::DBus::Binding::Connection->new(address => "unix:path=/path/to/socket");
+
+  $con->send($message);
+
+Registering message handlers
+
+  sub handle_something {
+      my $con = shift;
+      my $msg = shift;
+
+      ... do something with the message...
+  }
+
+  $con->register_message_handler(
+    "/some/object/path",
+    \&handle_something);
+
+Hooking up to an event loop:
+
+  my $reactor = Net::DBus::Binding::Reactor->new();
+
+  $reactor->manage($con);
+
+  $reactor->run();
+
+=head1 DESCRIPTION
+
+An outgoing connection to a server, or an incoming connection
+from a client. The methods defined on this module have a close
+correspondance to the dbus_connection_XXX methods in the C API,
+so for further details on their behaviour, the C API documentation
+may be of use.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::Connection;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+use Net::DBus::Binding::Message::MethodCall;
+use Net::DBus::Binding::Message::MethodReturn;
+use Net::DBus::Binding::Message::Error;
+use Net::DBus::Binding::Message::Signal;
+use Net::DBus::Binding::PendingCall;
+
+=item my $con = Net::DBus::Binding::Connection->new(address => "unix:path=/path/to/socket");
+
+Creates a new connection to the remove server specified by
+the parameter C<address>. 
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+    my $self = {};
+
+    $self->{address} = exists $params{address} ? $params{address} : (exists $params{connection} ? "" : die "address parameter is required");
+    $self->{connection} = exists $params{connection} ? $params{connection} : Net::DBus::Binding::Connection::_open($self->{address});
+
+    bless $self, $class;
+
+    $self->{connection}->_set_owner($self);
+
+    return $self;
+}
+
+
+=item $status = $con->is_connected();
+
+Returns zero if the connection has been disconnected,
+otherwise a positive value is returned.
+
+=cut
+
+sub is_connected {
+    my $self = shift;
+    
+    return $self->{connection}->dbus_connection_get_is_connected();
+}
+
+=item $status = $con->is_authenticated();
+
+Returns zero if the connection has not yet successfully
+completed authentication, otherwise a positive value is
+returned.
+
+=cut
+
+sub is_authenticated {
+    my $self = shift;
+    
+    return $self->{connection}->dbus_connection_get_is_authenticated();
+}
+
+
+=item $con->disconnect()
+
+Closes this connection to the remote host. This method
+is called automatically during garbage collection (ie
+in the DESTROY method) if the programmer forgets to
+explicitly disconnect.
+
+=cut
+
+sub disconnect {
+    my $self = shift;
+    
+    $self->{connection}->dbus_connection_disconnect();
+}
+
+=item $con->flush()
+
+Blocks execution until all data in the outgoing data
+stream has been sent. This method will not re-enter
+the application event loop.
+
+=cut
+
+sub flush {
+    my $self = shift;
+    
+    $self->{connection}->dbus_connection_flush();
+}
+
+
+=item $con->send($message)
+
+Queues a message up for sending to the remote host.
+The data will be sent asynchronously as the applications
+event loop determines there is space in the outgoing 
+socket send buffer. To force immediate sending of the
+data, follow this method will a call to C<flush>. This
+method will return the serial number of the message,
+which can be used to identify a subsequent reply (if
+any).
+
+=cut
+
+sub send {
+    my $self = shift;
+    my $msg = shift;
+
+    return $self->{connection}->_send($msg->{message});
+}
+
+=item my $reply = $con->send_with_reply_and_block($msg, $timeout);
+
+Queues a message up for sending to the remote host
+and blocks until it has been sent, and a corresponding
+reply received. The return value of this method will
+be a C<Net::DBus::Binding::Message::MethodReturn> or C<Net::DBus::Binding::Message::Error>
+object.
+
+=cut
+
+sub send_with_reply_and_block {
+    my $self = shift;
+    my $msg = shift;
+    my $timeout = shift;
+
+    my $reply = $self->{connection}->_send_with_reply_and_block($msg->{message}, $timeout);
+
+    my $type = $reply->dbus_message_get_type;
+    if ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_ERROR) {
+	return $self->make_raw_message($reply);
+    } elsif ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN) {
+	return $self->make_raw_message($reply);
+    } else {
+	die "unknown method reply type $type";
+    }
+}
+
+
+=item my $pending_call = $con->send_with_reply($msg, $timeout);
+
+Queues a message up for sending to the remote host
+and returns immediately providing a reference to a
+C<Net::DBus::Binding::PendingCall> object. This object
+can be used to wait / watch for a reply. This allows
+methods to be processed asynchronously.
+
+=cut
+
+sub send_with_reply {
+    my $self = shift;
+    my $msg = shift;
+    my $timeout = shift;
+
+    my $reply = $self->{connection}->_send_with_reply($msg->{message}, $timeout);
+
+    return Net::DBus::Binding::PendingCall->new(connection => $self,
+						method_call => $msg,
+						pending_call => $reply);
+}
+
+
+=item $con->dispatch;
+
+Dispatches any pending messages in the incoming queue
+to their message handlers. This method is typically
+called on each iteration of the main application event
+loop where data has been read from the incoming socket.
+
+=cut
+
+sub dispatch {
+    my $self = shift;
+    
+    $self->{connection}->_dispatch();
+}
+
+
+=item $message = $con->borrow_message
+
+Temporarily removes the first message from the incoming
+message queue. No other thread may access the message
+while it is 'borrowed', so it should be replaced in the
+queue with the C<return_message> method, or removed 
+permanently with th C<steal_message> method as soon as
+is practical.
+
+=cut
+
+sub borrow_message {
+    my $self = shift;
+    
+    my $msg = $self->{connection}->dbus_connection_borrow_message();
+    return $self->make_raw_message($msg);
+}
+
+=item $con->return_message($msg)
+
+Replaces a previously borrowed message in the incoming
+message queue for subsequent dispatch to registered 
+message handlers.
+
+=cut
+
+sub return_message {
+    my $self = shift;
+    my $msg = shift;
+    
+    $self->{connection}->dbus_connection_return_message($msg->{message});
+}
+
+
+=item $con->steal_message($msg)
+
+Permanently remove a borrowed message from the incoming
+message queue. No registered message handlers will now
+be run for this message.
+
+=cut
+
+sub steal_message {
+    my $self = shift;
+    my $msg = shift;
+    
+    $self->{connection}->dbus_connection_steal_borrowed_message($msg->{message});
+}
+
+=item $msg = $con->pop_message();
+
+Permanently removes the first message on the incoming
+message queue, without running any registered message
+handlers. If you have hooked the connection up to an
+event loop (C<Net::DBus::Binding::Reactor> for example), you probably
+don't want to be calling this method.
+
+=cut
+
+sub pop_message {
+    my $self = shift;
+    
+    my $msg = $self->{connection}->dbus_connection_pop_message();
+    return $self->make_raw_message($msg);
+}
+
+=item $con->set_watch_callbacks(\&add_watch, \&remove_watch, \&toggle_watch);
+
+Register a set of callbacks for adding, removing & updating 
+watches in the application's event loop. Each parameter
+should be a code reference, which on each invocation, will be
+supplied with two parameters, the connection object and the
+watch object. If you are using a C<Net::DBus::Binding::Reactor> object
+as the application event loop, then the 'manage' method on
+that object will call this on your behalf.
+
+=cut
+
+sub set_watch_callbacks {
+    my $self = shift;
+    my $add = shift;
+    my $remove = shift;
+    my $toggled = shift;
+
+    $self->{add_watch} = $add;
+    $self->{remove_watch} = $remove;
+    $self->{toggled_watch} = $toggled;
+
+    $self->{connection}->_set_watch_callbacks();
+}
+
+=item $con->set_timeout_callbacks(\&add_timeout, \&remove_timeout, \&toggle_timeout);
+
+Register a set of callbacks for adding, removing & updating 
+timeouts in the application's event loop. Each parameter
+should be a code reference, which on each invocation, will be
+supplied with two parameters, the connection object and the
+timeout object. If you are using a C<Net::DBus::Binding::Reactor> object
+as the application event loop, then the 'manage' method on
+that object will call this on your behalf.
+
+=cut
+
+sub set_timeout_callbacks {
+    my $self = shift;
+    my $add = shift;
+    my $remove = shift;
+    my $toggled = shift;
+
+    $self->{add_timeout} = $add;
+    $self->{remove_timeout} = $remove;
+    $self->{toggled_timeout} = $toggled;
+
+    $self->{connection}->_set_timeout_callbacks();
+}
+
+=item $con->register_object_path($path, \&handler)
+
+Registers a handler for messages whose path matches
+that specified in the C<$path> parameter. The supplied
+code reference will be invoked with two parameters, the
+connection object on which the message was received,
+and the message to be processed (an instance of the
+C<Net::DBus::Binding::Message> class).
+
+=cut
+
+sub register_object_path {
+    my $self = shift;
+    my $path = shift;
+    my $code = shift;
+
+    my $callback = sub {
+	my $con = shift;
+	my $msg = shift;
+
+	&$code($con, $self->make_raw_message($msg));
+    };
+    $self->{connection}->_register_object_path($path, $callback);
+}
+
+=item $con->unregister_object_path($path)
+
+Unregisters the handler associated with the object path C<$path>. The
+handler would previously have been registered with the C<register_object_path>
+or C<register_fallback> methods.
+
+=cut
+
+sub unregister_object_path {
+    my $self = shift;
+    my $path = shift;
+    $self->{connection}->_unregister_object_path($path);
+}
+
+
+=item $con->register_fallback($path, \&handler)
+
+Registers a handler for messages whose path starts with 
+the prefix specified in the C<$path> parameter. The supplied
+code reference will be invoked with two parameters, the
+connection object on which the message was received,
+and the message to be processed (an instance of the
+C<Net::DBus::Binding::Message> class).
+
+=cut
+
+sub register_fallback {
+    my $self = shift;
+    my $path = shift;
+    my $code = shift;
+
+    my $callback = sub {
+	my $con = shift;
+	my $msg = shift;
+
+	&$code($con, $self->make_raw_message($msg));
+    };
+
+    $self->{connection}->_register_fallback($path, $callback);
+}
+
+
+=item $con->set_max_message_size($bytes)
+
+Sets the maximum allowable size of a single incoming
+message. Messages over this size will be rejected
+prior to exceeding this threshold. The message size
+is specified in bytes.
+
+=cut
+
+sub set_max_message_size {
+    my $self = shift;
+    my $size = shift;
+    
+    $self->{connection}->dbus_connection_set_max_message_size($size);
+}
+
+=item $bytes = $con->get_max_message_size();
+
+Retrieves the maximum allowable incoming
+message size. The returned size is measured
+in bytes.
+
+=cut
+
+sub get_max_message_size {
+    my $self = shift;
+    
+    return $self->{connection}->dbus_connection_get_max_message_size;
+}
+
+=item $con->set_max_received_size($bytes)
+
+Sets the maximum size of the incoming message queue.
+Once this threashold is exceeded, no more messages will
+be read from wire before one or more of the existing
+messages are dispatched to their registered handlers.
+The implication is that the message queue can exceed
+this threshold by at most the size of a single message.
+
+=cut
+
+sub set_max_received_size {
+    my $self = shift;
+    my $size = shift;
+    
+    $self->{connection}->dbus_connection_set_max_received_size($size);
+}
+
+=item $bytes $con->get_max_received_size()
+
+Retrieves the maximum incoming message queue size.
+The returned size is measured in bytes.
+
+=cut
+
+sub get_max_received_size {
+    my $self = shift;
+    
+    return $self->{connection}->dbus_connection_get_max_received_size;
+}
+
+
+=item $con->add_filter($coderef);
+
+Adds a filter to the connection which will be invoked whenever a
+message is received. The C<$coderef> should be a reference to a
+subroutine, which returns a true value if the message should be
+filtered out, or a false value if the normal message dispatch
+should be performed.
+
+=cut
+
+sub add_filter {
+    my $self = shift;
+    my $callback = shift;
+    
+    $self->{connection}->_add_filter($callback);
+}
+
+
+sub _message_filter {
+    my $self = shift;
+    my $rawmsg = shift;
+    my $code = shift;
+    
+    my $msg = $self->make_raw_message($rawmsg);
+    return &$code($self, $msg);
+}
+
+
+=item my $msg = $con->make_raw_message($rawmsg)
+
+Creates a new message, initializing it from the low level C message
+object provided by the C<$rawmsg> parameter. The returned object
+will be cast to the appropriate subclass of L<Net::DBus::Binding::Message>.
+
+=cut
+
+sub make_raw_message {
+    my $self = shift;
+    my $rawmsg = shift;
+    
+    return Net::DBus::Binding::Message->new(message => $rawmsg);
+}
+
+
+=item my $msg = $con->make_error_message(
+      replyto => $method_call, name => $name, description => $description);
+
+Creates a new message, representing an error which occurred during
+the handling of the method call object passed in as the C<replyto>
+parameter. The C<name> parameter is the formal name of the error
+condition, while the C<description> is a short piece of text giving
+more specific information on the error.
+
+=cut
+
+
+sub make_error_message {
+    my $self = shift;
+    my $replyto = shift;
+    my $name = shift;
+    my $description = shift;
+    
+    return Net::DBus::Binding::Message::Error->new(replyto => $replyto,
+						   name => $name,
+						   description => $description);
+}
+
+=item my $call = $con->make_method_call_message(
+  $service_name, $object_path, $interface, $method_name);
+
+Create a message representing a call on the object located at
+the path C<$object_path> within the client owning the well-known
+name given by C<$service_name>. The method to be invoked has
+the name C<$method_name> within the interface specified by the
+C<$interface> parameter.
+
+=cut
+
+
+sub make_method_call_message {
+    my $self = shift;
+    my $service_name = shift;
+    my $object_path = shift;
+    my $interface = shift;
+    my $method_name = shift;
+
+    return Net::DBus::Binding::Message::MethodCall->new(service_name => $service_name,
+							object_path => $object_path,
+							interface => $interface,
+							method_name => $method_name);
+}
+
+=item my $msg = $con->make_method_return_message(
+    replyto => $method_call);
+
+Create a message representing a reply to the method call passed in
+the C<replyto> parameter.
+
+=cut
+
+
+sub make_method_return_message {
+    my $self = shift;
+    my $replyto = shift;
+
+    return Net::DBus::Binding::Message::MethodReturn->new(call => $replyto);
+}
+
+
+=item my $signal = $con->make_signal_message(
+      object_path => $path, interface => $interface, signal_name => $name);
+
+Creates a new message, representing a signal [to be] emitted by
+the object located under the path given by the C<object_path>
+parameter. The name of the signal is given by the C<signal_name>
+parameter, and is scoped to the interface given by the
+C<interface> parameter.
+
+=cut
+
+sub make_signal_message {
+    my $self = shift;
+    my $object_path = shift;
+    my $interface = shift;
+    my $signal_name = shift;
+
+    return Net::DBus::Binding::Message::Signal->new(object_path => $object_path,
+						    interface => $interface,
+						    signal_name => $signal_name);
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Server>, L<Net::DBus::Binding::Bus>, L<Net::DBus::Binding::Message::Signal>, L<Net::DBus::Binding::Message::MethodCall>, L<Net::DBus::Binding::Message::MethodReturn>, L<Net::DBus::Binding::Message::Error>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan@berrange.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Daniel Berrange
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Introspector.pm b/Net-DBus/lib/Net/DBus/Binding/Introspector.pm
new file mode 100644
index 0000000..527d4c0
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Introspector.pm
@@ -0,0 +1,1081 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Introspector - Handler for object introspection data
+
+=head1 SYNOPSIS
+
+  # Create an object populating with info from an
+  # XML doc containing introspection data.
+
+  my $ins = Net::DBus::Binding::Introspector->new(xml => $data);
+
+  # Create an object, defining introspection data
+  # programmatically
+  my $ins = Net::DBus::Binding::Introspector->new(object_path => $object->get_object_path);
+  $ins->add_method("DoSomething", ["string"], [], "org.example.MyObject");
+  $ins->add_method("TestSomething", ["int32"], [], "org.example.MyObject");
+
+=head1 DESCRIPTION
+
+This class is responsible for managing introspection data, and
+answering questions about it. This is not intended for use by
+application developers, whom should instead consult the higher
+level API in L<Net::DBus::Exporter>.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::Introspector;
+
+use 5.006;
+use strict;
+use warnings;
+
+use XML::Twig;
+
+use Net::DBus::Binding::Message;
+
+our %simple_type_map = (
+  "byte" => &Net::DBus::Binding::Message::TYPE_BYTE,
+  "bool" => &Net::DBus::Binding::Message::TYPE_BOOLEAN,
+  "double" => &Net::DBus::Binding::Message::TYPE_DOUBLE,
+  "string" => &Net::DBus::Binding::Message::TYPE_STRING,
+  "int16" => &Net::DBus::Binding::Message::TYPE_INT16,
+  "uint16" => &Net::DBus::Binding::Message::TYPE_UINT16,
+  "int32" => &Net::DBus::Binding::Message::TYPE_INT32,
+  "uint32" => &Net::DBus::Binding::Message::TYPE_UINT32,
+  "int64" => &Net::DBus::Binding::Message::TYPE_INT64,
+  "uint64" => &Net::DBus::Binding::Message::TYPE_UINT64,
+  "objectpath" => &Net::DBus::Binding::Message::TYPE_OBJECT_PATH,
+  "signature" => &Net::DBus::Binding::Message::TYPE_SIGNATURE,
+);
+
+our %simple_type_rev_map = (
+  &Net::DBus::Binding::Message::TYPE_BYTE => "byte",
+  &Net::DBus::Binding::Message::TYPE_BOOLEAN => "bool",
+  &Net::DBus::Binding::Message::TYPE_DOUBLE => "double",
+  &Net::DBus::Binding::Message::TYPE_STRING => "string",
+  &Net::DBus::Binding::Message::TYPE_INT16 => "int16",
+  &Net::DBus::Binding::Message::TYPE_UINT16 => "uint16",
+  &Net::DBus::Binding::Message::TYPE_INT32 => "int32",
+  &Net::DBus::Binding::Message::TYPE_UINT32 => "uint32",
+  &Net::DBus::Binding::Message::TYPE_INT64 => "int64",
+  &Net::DBus::Binding::Message::TYPE_UINT64 => "uint64",
+  &Net::DBus::Binding::Message::TYPE_OBJECT_PATH => "objectpath",
+  &Net::DBus::Binding::Message::TYPE_SIGNATURE => "signature",
+);
+
+our %magic_type_map = (
+  "caller" => sub {
+    my $msg = shift;
+
+    return $msg->get_sender;
+  },
+  "serial" => sub {
+    my $msg = shift;
+
+    return $msg->get_serial;
+  },
+);
+
+our %compound_type_map = (
+  "array" => &Net::DBus::Binding::Message::TYPE_ARRAY,
+  "struct" => &Net::DBus::Binding::Message::TYPE_STRUCT,
+  "dict" => &Net::DBus::Binding::Message::TYPE_DICT_ENTRY,
+  "variant" => &Net::DBus::Binding::Message::TYPE_VARIANT,
+);
+
+=item my $ins = Net::DBus::Binding::Introspector->new(object_path => $object_path,
+						      xml => $xml);
+
+Creates a new introspection data manager for the object registered
+at the path specified for the C<object_path> parameter. The optional
+C<xml> parameter can be used to pre-load the manager with introspection
+metadata from an XML document.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $self = {};
+    my %params = @_;
+
+    $self->{interfaces} = {};
+
+    bless $self, $class;
+
+    if (defined $params{xml}) {
+	$self->{object_path} = exists $params{object_path} ? $params{object_path} : undef;
+	$self->_parse($params{xml});
+    } elsif (defined $params{node}) {
+	$self->{object_path} = exists $params{object_path} ? $params{object_path} : undef;
+	$self->_parse_node($params{node});
+    } else {
+	$self->{object_path} = exists $params{object_path} ? $params{object_path} : die "object_path parameter is required";
+	$self->{interfaces} = $params{interfaces} if exists $params{interfaces};
+	$self->{children} = exists $params{children} ? $params{children} : [];
+    }
+
+    # XXX it is really a bug that these aren't included in the introspection
+    # data the bus generates
+    if ($self->{object_path} eq "/org/freedesktop/DBus") {
+	if (!$self->has_signal("NameOwnerChanged")) {
+	    $self->add_signal("NameOwnerChanged", ["string","string","string"], "org.freedesktop.DBus");
+	}
+	if (!$self->has_signal("NameLost")) {
+	    $self->add_signal("NameLost", ["string"], "org.freedesktop.DBus");
+	}
+	if (!$self->has_signal("NameAcquired")) {
+	    $self->add_signal("NameAcquired", ["string"], "org.freedesktop.DBus");
+	}
+    }
+
+    return $self;
+}
+
+=item $ins->add_interface($name)
+
+Register the object as providing an interface with the name C<$name>
+
+=cut
+
+sub add_interface {
+    my $self = shift;
+    my $name = shift;
+
+    $self->{interfaces}->{$name} = {
+	methods => {},
+	signals => {},
+	props => {},
+    } unless exists $self->{interfaces}->{$name};
+}
+
+=item my $bool = $ins->has_interface($name)
+
+Return a true value if the object is registered as providing
+an interface with the name C<$name>; returns false otherwise.
+
+=cut
+
+sub has_interface {
+    my $self = shift;
+    my $name = shift;
+
+    return exists $self->{interfaces}->{$name} ? 1 : 0;
+}
+
+=item my @interfaces = $ins->has_method($name)
+
+Return a list of all interfaces provided by the object, which
+contain a method called C<$name>. This may be an empty list.
+
+=cut
+
+sub has_method {
+    my $self = shift;
+    my $name = shift;
+
+    my @interfaces;
+    foreach my $interface (keys %{$self->{interfaces}}) {
+	if (exists $self->{interfaces}->{$interface}->{methods}->{$name}) {
+	    push @interfaces, $interface;
+	}
+    }
+
+    return @interfaces;
+}
+
+=item my @interfaces = $ins->has_signal($name)
+
+Return a list of all interfaces provided by the object, which
+contain a signal called C<$name>. This may be an empty list.
+
+=cut
+
+sub has_signal {
+    my $self = shift;
+    my $name = shift;
+
+    my @interfaces;
+    foreach my $interface (keys %{$self->{interfaces}}) {
+	if (exists $self->{interfaces}->{$interface}->{signals}->{$name}) {
+	    push @interfaces, $interface;
+	}
+    }
+    return @interfaces;
+}
+
+=item my @interfaces = $ins->has_property($name)
+
+Return a list of all interfaces provided by the object, which
+contain a property called C<$name>. This may be an empty list.
+
+=cut
+
+sub has_property {
+    my $self = shift;
+    my $name = shift;
+
+    if (@_) {
+	my $interface = shift;
+	return () unless exists $self->{interfaces}->{$interface};
+	return () unless exists $self->{interfaces}->{$interface}->{props}->{$name};
+	return ($interface);
+    } else {
+	my @interfaces;
+	foreach my $interface (keys %{$self->{interfaces}}) {
+	    if (exists $self->{interfaces}->{$interface}->{props}->{$name}) {
+		push @interfaces, $interface;
+	    }
+	}
+	return @interfaces;
+    }
+}
+
+=item $ins->add_method($name, $params, $returns, $interface, $attributes);
+
+Register the object as providing a method called C<$name> accepting parameters
+whose types are declared by C<$params> and returning values whose type
+are declared by C<$returns>. The method will be scoped to the inteface
+named by C<$interface>. The C<$attributes> parameter is a hash reference
+for annotating the method.
+
+=cut
+
+sub add_method {
+    my $self = shift;
+    my $name = shift;
+    my $params = shift;
+    my $returns = shift;
+    my $interface = shift;
+    my $attributes = shift;
+
+    $self->add_interface($interface);
+    $self->{interfaces}->{$interface}->{methods}->{$name} = {
+	params => $params,
+	returns => $returns,
+	deprecated => $attributes->{deprecated} ? 1 : 0,
+	no_reply => $attributes->{no_return} ? 1 : 0,
+    };
+}
+
+=item $ins->add_signal($name, $params, $interface, $attributes);
+
+Register the object as providing a signal called C<$name> with parameters
+whose types are declared by C<$params>. The signal will be scoped to the inteface
+named by C<$interface>. The C<$attributes> parameter is a hash reference
+for annotating the signal.
+
+=cut
+
+sub add_signal {
+    my $self = shift;
+    my $name = shift;
+    my $params = shift;
+    my $interface = shift;
+    my $attributes = shift;
+
+    $self->add_interface($interface);
+    $self->{interfaces}->{$interface}->{signals}->{$name} = {
+	params => $params,
+	deprecated => $attributes->{deprecated} ? 1 : 0,
+    };
+}
+
+=item $ins->add_property($name, $type, $access, $interface, $attributes);
+
+Register the object as providing a property called C<$name> with a type
+of C<$type>. The C<$access> parameter can be one of C<read>, C<write>,
+or C<readwrite>. The property will be scoped to the inteface
+named by C<$interface>. The C<$attributes> parameter is a hash reference
+for annotating the signal.
+
+=cut
+
+sub add_property {
+    my $self = shift;
+    my $name = shift;
+    my $type = shift;
+    my $access = shift;
+    my $interface = shift;
+    my $attributes = shift;
+
+    $self->add_interface($interface);
+    $self->{interfaces}->{$interface}->{props}->{$name} = {
+	type => $type,
+	access => $access,
+	deprecated => $attributes->{deprecated} ? 1 : 0,
+    };
+}
+
+=item my $boolean = $ins->is_method_deprecated($name, $interface)
+
+Returns a true value if the method called C<$name> in the interface
+C<$interface> is marked as deprecated
+
+=cut
+
+sub is_method_deprecated {
+    my $self = shift;
+    my $name = shift;
+    my $interface = shift;
+
+    die "no interface $interface" unless exists $self->{interfaces}->{$interface};
+    die "no method $name in interface $interface" unless exists $self->{interfaces}->{$interface}->{methods}->{$name};
+    return 1 if $self->{interfaces}->{$interface}->{methods}->{$name}->{deprecated};
+    return 0;
+}
+
+=item my $boolean = $ins->is_signal_deprecated($name, $interface)
+
+Returns a true value if the signal called C<$name> in the interface
+C<$interface> is marked as deprecated
+
+=cut
+
+sub is_signal_deprecated {
+    my $self = shift;
+    my $name = shift;
+    my $interface = shift;
+
+    die "no interface $interface" unless exists $self->{interfaces}->{$interface};
+    die "no signal $name in interface $interface" unless exists $self->{interfaces}->{$interface}->{signals}->{$name};
+    return 1 if $self->{interfaces}->{$interface}->{signals}->{$name}->{deprecated};
+    return 0;
+}
+
+=item my $boolean = $ins->is_property_deprecated($name, $interface)
+
+Returns a true value if the property called C<$name> in the interface
+C<$interface> is marked as deprecated
+
+=cut
+
+sub is_property_deprecated {
+    my $self = shift;
+    my $name = shift;
+    my $interface = shift;
+
+    die "no interface $interface" unless exists $self->{interfaces}->{$interface};
+    die "no property $name in interface $interface" unless exists $self->{interfaces}->{$interface}->{props}->{$name};
+    return 1 if $self->{interfaces}->{$interface}->{props}->{$name}->{deprecated};
+    return 0;
+}
+
+=item my $boolean = $ins->does_method_reply($name, $interface)
+
+Returns a true value if the method called C<$name> in the interface
+C<$interface> will generate a reply. Returns a false value otherwise.
+
+=cut
+
+sub does_method_reply {
+    my $self = shift;
+    my $name = shift;
+    my $interface = shift;
+
+    die "no interface $interface" unless exists $self->{interfaces}->{$interface};
+    die "no method $name in interface $interface" unless exists $self->{interfaces}->{$interface}->{methods}->{$name};
+    return 0 if $self->{interfaces}->{$interface}->{methods}->{$name}->{no_reply};
+    return 1;
+}
+
+=item my @names = $ins->list_interfaces
+
+Returns a list of all interfaces registered as being provided
+by the object.
+
+=cut
+
+sub list_interfaces {
+    my $self = shift;
+
+    return keys %{$self->{interfaces}};
+}
+
+=item my @names = $ins->list_methods($interface)
+
+Returns a list of all methods registered as being provided
+by the object, within the interface C<$interface>.
+
+=cut
+
+sub list_methods {
+    my $self = shift;
+    my $interface = shift;
+    return keys %{$self->{interfaces}->{$interface}->{methods}};
+}
+
+=item my @names = $ins->list_signals($interface)
+
+Returns a list of all signals registered as being provided
+by the object, within the interface C<$interface>.
+
+=cut
+
+sub list_signals {
+    my $self = shift;
+    my $interface = shift;
+    return keys %{$self->{interfaces}->{$interface}->{signals}};
+}
+
+=item my @names = $ins->list_properties($interface)
+
+Returns a list of all properties registered as being provided
+by the object, within the interface C<$interface>.
+
+=cut
+
+sub list_properties {
+    my $self = shift;
+    my $interface = shift;
+    return keys %{$self->{interfaces}->{$interface}->{props}};
+}
+
+=item my @paths = $self->list_children;
+
+Returns a list of object paths representing all the children
+of this node.
+
+=cut
+
+sub list_children {
+    my $self = shift;
+    return @{$self->{children}};
+}
+
+=item my $path = $ins->get_object_path
+
+Returns the path of the object associated with this introspection
+data
+
+=cut
+
+sub get_object_path {
+    my $self = shift;
+    return $self->{object_path};
+}
+
+=item my @types = $ins->get_method_params($interface, $name)
+
+Returns a list of declared data types for parameters of the
+method called C<$name> within the interface C<$interface>.
+
+=cut
+
+sub get_method_params {
+    my $self = shift;
+    my $interface = shift;
+    my $method = shift;
+    return @{$self->{interfaces}->{$interface}->{methods}->{$method}->{params}};
+}
+
+=item my @types = $ins->get_method_returns($interface, $name)
+
+Returns a list of declared data types for return values of the
+method called C<$name> within the interface C<$interface>.
+
+=cut
+
+sub get_method_returns {
+    my $self = shift;
+    my $interface = shift;
+    my $method = shift;
+    return @{$self->{interfaces}->{$interface}->{methods}->{$method}->{returns}};
+}
+
+=item my @types = $ins->get_signal_params($interface, $name)
+
+Returns a list of declared data types for values associated with the
+signal called C<$name> within the interface C<$interface>.
+
+=cut
+
+sub get_signal_params {
+    my $self = shift;
+    my $interface = shift;
+    my $signal = shift;
+    return @{$self->{interfaces}->{$interface}->{signals}->{$signal}->{params}};
+}
+
+=item my $type = $ins->get_property_type($interface, $name)
+
+Returns the declared data type for property called C<$name> within
+the interface C<$interface>.
+
+=cut
+
+sub get_property_type {
+    my $self = shift;
+    my $interface = shift;
+    my $prop = shift;
+    return $self->{interfaces}->{$interface}->{props}->{$prop}->{type};
+}
+
+=item my $bool = $ins->is_property_readable($interface, $name);
+
+Returns a true value if the property called C<$name> within the
+interface C<$interface> can have its value read.
+
+=cut
+
+sub is_property_readable {
+    my $self = shift;
+    my $interface = shift;
+    my $prop = shift;
+    my $access = $self->{interfaces}->{$interface}->{props}->{$prop}->{access};
+    return $access eq "readwrite" || $access eq "read" ? 1 : 0;
+}
+
+=item my $bool = $ins->is_property_writable($interface, $name);
+
+Returns a true value if the property called C<$name> within the
+interface C<$interface> can have its value written to.
+
+=cut
+
+sub is_property_writable {
+    my $self = shift;
+    my $interface = shift;
+    my $prop = shift;
+    my $access = $self->{interfaces}->{$interface}->{props}->{$prop}->{access};
+    return $access eq "readwrite" || $access eq "write" ? 1 : 0;
+}
+
+sub _parse {
+    my $self = shift;
+    my $xml = shift;
+
+    my $twig = XML::Twig->new();
+    $twig->parse($xml);
+
+    $self->_parse_node($twig->root);
+}
+
+sub _parse_node {
+    my $self = shift;
+    my $node = shift;
+
+    $self->{object_path} = $node->att("name") if defined $node->att("name");
+    die "no object path provided" unless defined $self->{object_path};
+    $self->{children} = [];
+    foreach my $child ($node->children("interface")) {
+	$self->_parse_interface($child);
+    }
+    foreach my $child ($node->children("node")) {
+	if (!$child->has_children()) {
+	    push @{$self->{children}}, $child->att("name");
+	} else {
+	    push @{$self->{children}}, $self->new(node => $child);
+	}
+    }
+}
+
+sub _parse_interface {
+    my $self = shift;
+    my $node = shift;
+
+    my $name = $node->att("name");
+    $self->{interfaces}->{$name} = {
+	methods => {},
+	signals => {},
+	props => {},
+    };
+
+    foreach my $child ($node->children("method")) {
+	$self->_parse_method($child, $name);
+    }
+    foreach my $child ($node->children("signal")) {
+	$self->_parse_signal($child, $name);
+    }
+    foreach my $child ($node->children("property")) {
+	$self->_parse_property($child, $name);
+    }
+}
+
+sub _parse_method {
+    my $self = shift;
+    my $node = shift;
+    my $interface = shift;
+
+    my $name = $node->att("name");
+    my @params;
+    my @returns;
+    my $deprecated = 0;
+    my $no_reply = 0;
+    foreach my $child ($node->children("arg")) {
+	my $type = $child->att("type");
+	my $direction = $child->att("direction");
+
+	my @sig = split //, $type;
+	my @type = $self->_parse_type(\@sig);
+	if (!defined $direction || $direction eq "in") {
+	    push @params, @type;
+	} elsif ($direction eq "out") {
+	    push @returns, @type;
+	}
+    }
+    foreach my $child ($node->children("annotation")) {
+	my $name = $child->att("name");
+	my $value = $child->att("value");
+
+	if ($name eq "org.freedesktop.DBus.Deprecated") {
+	    $deprecated = 1 if lc($value) eq "true";
+	} elsif ($name eq "org.freedesktop.DBus.Method.NoReply") {
+	    $no_reply = 1 if lc($value) eq "true";
+	}
+    }
+
+    $self->{interfaces}->{$interface}->{methods}->{$name} = {
+	params => \@params,
+	returns => \@returns,
+	no_reply => $no_reply,
+	deprecated => $deprecated,
+    }
+}
+
+sub _parse_type {
+    my $self = shift;
+    my $sig = shift;
+
+    my $root = [];
+    my $current = $root;
+    my @cont;
+    while (my $type = shift @{$sig}) {
+	if (exists $simple_type_rev_map{ord($type)}) {
+	    push @{$current}, $simple_type_rev_map{ord($type)};
+	    if ($current->[0] eq "array") {
+		$current = pop @cont;
+	    }
+	} else {
+	    if ($type eq "(") {
+		my $new = ["struct"];
+		push @{$current}, $new;
+		push @cont, $current;
+		$current = $new;
+	    } elsif ($type eq "a") {
+		my $new = ["array"];
+		push @cont, $current;
+		push @{$current}, $new;
+		$current = $new;
+	    } elsif ($type eq "{") {
+		if ($current->[0] ne "array") {
+		    die "dict must only occur within an array";
+		}
+		$current->[0] = "dict";
+	    } elsif ($type eq ")") {
+		die "unexpected end of struct" unless
+		    $current->[0] eq "struct";
+		$current = pop @cont;
+		if ($current->[0] eq "array") {
+		    $current = pop @cont;
+		}
+	    } elsif ($type eq "}") {
+		die "unexpected end of dict" unless
+		    $current->[0] eq "dict";
+		$current = pop @cont;
+		if ($current->[0] eq "array") {
+		    $current = pop @cont;
+		}
+	    } elsif ($type eq "v") {
+		push @{$current}, "variant";
+		if ($current->[0] eq "array") {
+		    $current = pop @cont;
+		}
+	    } else {
+		die "unknown type sig '$type'";
+	    }
+	}
+    }
+    return @{$root};
+}
+
+sub _parse_signal {
+    my $self = shift;
+    my $node = shift;
+    my $interface = shift;
+
+    my $name = $node->att("name");
+    my @params;
+    my $deprecated = 0;
+    foreach my $child ($node->children("arg")) {
+	my $type = $child->att("type");
+	my @sig = split //, $type;
+	my @type = $self->_parse_type(\@sig);
+	push @params, @type;
+    }
+    foreach my $child ($node->children("annotation")) {
+	my $name = $child->att("name");
+	my $value = $child->att("value");
+
+	if ($name eq "org.freedesktop.DBus.Deprecated") {
+	    $deprecated = 1 if lc($value) eq "true";
+	}
+    }
+
+    $self->{interfaces}->{$interface}->{signals}->{$name} = {
+	params => \@params,
+	deprecated => $deprecated,
+    };
+}
+
+sub _parse_property {
+    my $self = shift;
+    my $node = shift;
+    my $interface = shift;
+
+    my $name = $node->att("name");
+    my $access = $node->att("access");
+    my $deprecated = 0;
+
+    foreach my $child ($node->children("annotation")) {
+	my $name = $child->att("name");
+	my $value = $child->att("value");
+
+	if ($name eq "org.freedesktop.DBus.Deprecated") {
+	    $deprecated = 1 if lc($value) eq "true";
+	}
+    }
+    $self->{interfaces}->{$interface}->{props}->{$name} = {
+	type =>  $self->_parse_type([$node->att("type")]),
+	access => $access,
+	deprecated => $deprecated,
+    };
+}
+
+=item my $xml = $ins->format
+
+Return a string containing an XML document representing the
+state of the introspection data.
+
+=cut
+
+sub format {
+    my $self = shift;
+
+    my $xml = '<!DOCTYPE node PUBLIC "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"' . "\n";
+    $xml .= '"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd">' . "\n";
+
+    return $xml . $self->to_xml("");
+}
+
+=item my $xml_fragment = $ins->to_xml
+
+Returns a string containing an XML fragment representing the
+state of the introspection data. This is basically the same
+as the C<format> method, but without the leading doctype
+declaration.
+
+=cut
+
+sub to_xml {
+    my $self = shift;
+    my $indent = shift;
+
+    my $xml = '';
+    $xml .= $indent . '<node name="' . $self->{object_path} . '">' . "\n";
+
+    foreach my $name (sort { $a cmp $b } keys %{$self->{interfaces}}) {
+	my $interface = $self->{interfaces}->{$name};
+	$xml .= $indent . '  <interface name="' . $name . '">' . "\n";
+	foreach my $mname (sort { $a cmp $b } keys %{$interface->{methods}}) {
+	    my $method = $interface->{methods}->{$mname};
+	    $xml .= $indent . '    <method name="' . $mname . '">' . "\n";
+
+	    foreach my $type (@{$method->{params}}) {
+		next if ! ref($type) && exists $magic_type_map{$type};
+		$xml .= $indent . '      <arg type="' . $self->to_xml_type($type) . '" direction="in"/>' . "\n";
+	    }
+
+	    foreach my $type (@{$method->{returns}}) {
+		next if ! ref($type) && exists $magic_type_map{$type};
+		$xml .= $indent . '      <arg type="' . $self->to_xml_type($type) . '" direction="out"/>' . "\n";
+	    }
+	    if ($method->{deprecated}) {
+		$xml .= $indent . '      <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>' . "\n";
+	    }
+	    if ($method->{no_reply}) {
+		$xml .= $indent . '      <annotation name="org.freedesktop.DBus.Method.NoReply" value="true"/>' . "\n";
+	    }
+	    $xml .= $indent . '    </method>' . "\n";
+	}
+	foreach my $sname (sort { $a cmp $b } keys %{$interface->{signals}}) {
+	    my $signal = $interface->{signals}->{$sname};
+	    $xml .= $indent . '    <signal name="' . $sname . '">' . "\n";
+
+	    foreach my $type (@{$signal->{params}}) {
+		next if ! ref($type) && exists $magic_type_map{$type};
+		$xml .= $indent . '      <arg type="' . $self->to_xml_type($type) . '"/>' . "\n";
+	    }
+	    if ($signal->{deprecated}) {
+		$xml .= $indent . '      <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>' . "\n";
+	    }
+	    $xml .= $indent . '    </signal>' . "\n";
+	}
+
+	foreach my $pname (sort { $a cmp $b } keys %{$interface->{props}}) {
+	    my $prop = $interface->{props}->{$pname};
+	    my $type = $interface->{props}->{$pname}->{type};
+	    my $access = $interface->{props}->{$pname}->{access};
+	    if ($prop->{deprecated}) {
+		$xml .= $indent . '    <property name="' . $pname . '" type="' .
+		    $self->to_xml_type($type) . '" access="' . $access . '">' . "\n";
+		$xml .= $indent . '      <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>' . "\n";
+		$xml .= $indent . '    </property>' . "\n";
+	    } else {
+		$xml .= $indent . '    <property name="' . $pname . '" type="' .
+		    $self->to_xml_type($type) . '" access="' . $access . '"/>' . "\n";
+	    }
+	}
+
+	$xml .= $indent . '  </interface>' . "\n";
+    }
+
+    foreach my $child (@{$self->{children}}) {
+	if (ref($child) eq __PACKAGE__) {
+	    $xml .= $child->to_xml($indent . "  ");
+	} else {
+	    $xml .= $indent . '  <node name="' . $child . '"/>' . "\n";
+	}
+    }
+    $xml .= $indent . "</node>\n";
+}
+
+=item $type = $ins->to_xml_type($type)
+
+Takes a text-based representation of a data type and returns
+the compact representation used in XML introspection data.
+
+=cut
+
+sub to_xml_type {
+    my $self = shift;
+    my $type = shift;
+
+    my $sig = '';
+    if (ref($type) eq "ARRAY") {
+	if ($type->[0] eq "array") {
+	    if ($#{$type} != 1) {
+		die "array spec must contain only 1 type";
+	    }
+	    $sig .= chr($compound_type_map{$type->[0]});
+	    $sig .= $self->to_xml_type($type->[1]);
+	} elsif ($type->[0] eq "struct") {
+	    $sig .= "(";
+	    for (my $i = 1 ; $i <= $#{$type} ; $i++) {
+		$sig .= $self->to_xml_type($type->[$i]);
+	    }
+	    $sig .= ")";
+	} elsif ($type->[0] eq "dict") {
+	    if ($#{$type} != 2) {
+		die "dict spec must contain only 2 types";
+	    }
+	    $sig .= chr($compound_type_map{"array"});
+	    $sig .= "{";
+	    $sig .= $self->to_xml_type($type->[1]);
+	    $sig .= $self->to_xml_type($type->[2]);
+	    $sig .= "}";
+	} elsif ($type->[0] eq "variant") {
+	    if ($#{$type} != 0) {
+		die "dict spec must contain no sub-types";
+	    }
+	    $sig .= chr($compound_type_map{"variant"});
+	} else {
+	    die "unknown/unsupported compound type " . $type->[0] . " expecting 'array', 'struct', or 'dict'";
+	}
+    } else {
+	die "unknown/unsupported scalar type '$type'"
+	    unless exists $simple_type_map{$type};
+	$sig .= chr($simple_type_map{$type});
+    }
+    return $sig;
+}
+
+=item $ins->encode($message, $type, $name, $direction, @args)
+
+Append a set of values <@args> to a message object C<$message>.
+The C<$type> parameter is either C<signal> or C<method> and
+C<$direction> is either C<params> or C<returns>. The introspection
+data will be queried to obtain the declared data types & the
+argument marshalling accordingly.
+
+=cut
+
+sub encode {
+    my $self = shift;
+    my $message = shift;
+    my $type = shift;
+    my $name = shift;
+    my $direction = shift;
+    my @args = @_;
+
+    my $interface = $message->get_interface;
+
+    if ($interface) {
+	die "no interface '$interface' in introspection data for object '" . $self->get_object_path . "' encoding $type '$name'\n"
+	    unless exists $self->{interfaces}->{$interface};
+	die "no introspection data when encoding $type '$name' in object " . $self->get_object_path . "\n"
+	    unless exists $self->{interfaces}->{$interface}->{$type}->{$name};
+    } else {
+	foreach my $in (keys %{$self->{interfaces}}) {
+	    if (exists $self->{interfaces}->{$in}->{$type}->{$name}) {
+		$interface = $in;
+	    }
+	}
+	if (!$interface) {
+	    die "no interface in introspection data for object " . $self->get_object_path . " encoding $type '$name'\n"
+	}
+    }
+
+    my @types =
+	@{$self->{interfaces}->{$interface}->{$type}->{$name}->{$direction}};
+
+    # If you don't explicitly 'return ()' from methods, Perl
+    # will always return a single element representing the
+    # return value of the last command executed in the method.
+    # To avoid this causing a PITA for methods exported with
+    # no return values, we throw away returns instead of dieing
+    if ($direction eq "returns" &&
+	$#types == -1 &&
+	$#args != -1) {
+	@args = ();
+    }
+
+    die "expected " . int(@types) . " $direction, but got " . int(@args)
+	unless $#types == $#args;
+
+    my $iter = $message->iterator(1);
+    foreach my $t ($self->_convert(@types)) {
+	$iter->append(shift @args, $t);
+    }
+}
+
+sub _convert {
+    my $self = shift;
+    my @in = @_;
+
+    my @out;
+    foreach my $in (@in) {
+	if (ref($in) eq "ARRAY") {
+	    my @subtype = @{$in};
+	    shift @subtype;
+	    my @subout = $self->_convert(@subtype);
+	    die "unknown compound type " . $in->[0] unless
+		exists $compound_type_map{lc $in->[0]};
+
+	    push @out, [$compound_type_map{lc $in->[0]}, \@subout];
+	} elsif (exists $magic_type_map{lc $in}) {
+	    push @out, $magic_type_map{lc $in};
+	} else {
+	    die "unknown simple type " . $in unless
+		exists $simple_type_map{lc $in};
+	    push @out, $simple_type_map{lc $in};
+	}
+    }
+    return @out;
+}
+
+=item my @args = $ins->decode($message, $type, $name, $direction)
+
+Unmarshalls the contents of a message object C<$message>.
+The C<$type> parameter is either C<signal> or C<method> and
+C<$direction> is either C<params> or C<returns>. The introspection
+data will be queried to obtain the declared data types & the
+arguments unmarshalled accordingly.
+
+=cut
+
+sub decode {
+    my $self = shift;
+    my $message = shift;
+    my $type = shift;
+    my $name = shift;
+    my $direction = shift;
+
+    my $interface = $message->get_interface;
+
+    if ($interface) {
+	die "no interface '$interface' in introspection data for object '" . $self->get_object_path . "' decoding $type '$name'\n"
+	    unless exists $self->{interfaces}->{$interface};
+	die "no introspection data when encoding $type '$name' in object " . $self->get_object_path . "\n"
+	    unless exists $self->{interfaces}->{$interface}->{$type}->{$name};
+    } else {
+	foreach my $in (keys %{$self->{interfaces}}) {
+	    if (exists $self->{interfaces}->{$in}->{$type}->{$name}) {
+		$interface = $in;
+	    }
+	}
+	if (!$interface) {
+	    die "no interface in introspection data for object " . $self->get_object_path . " decoding $type '$name'\n"
+	}
+    }
+
+    my @types =
+	@{$self->{interfaces}->{$interface}->{$type}->{$name}->{$direction}};
+
+    # If there are no types defined, just return the
+    # actual data from the message, assuming the introspection
+    # data was partial.
+    return $message->get_args_list
+	unless @types;
+
+    my $iter = $message->iterator;
+
+    my @rawtypes = $self->_convert(@types);
+    my @ret;
+    do {
+	my $type = shift @types;
+	my $rawtype = shift @rawtypes;
+
+	if (exists $magic_type_map{$type}) {
+	    push @ret, &$rawtype($message);
+	} else {
+	    push @ret, $iter->get($rawtype);
+	}
+    } while ($iter->next);
+    return @ret;
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Exporter>, L<Net::DBus::Binding::Message>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan@berrange.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Daniel Berrange
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Iterator.pm b/Net-DBus/lib/Net/DBus/Binding/Iterator.pm
new file mode 100644
index 0000000..62036a8
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Iterator.pm
@@ -0,0 +1,722 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Iterator - Reading and writing message parameters
+
+=head1 SYNOPSIS
+
+Creating a new message
+
+  my $msg = new Net::DBus::Binding::Message::Signal;
+  my $iterator = $msg->iterator;
+
+  $iterator->append_boolean(1);
+  $iterator->append_byte(123);
+
+
+Reading from a mesage
+
+  my $msg = ...get it from somewhere...
+  my $iter = $msg->iterator();
+
+  my $i = 0;
+  while ($iter->has_next()) {
+    $iter->next();
+    $i++;
+    if ($i == 1) {
+       my $val = $iter->get_boolean();
+    } elsif ($i == 2) {
+       my $val = $iter->get_byte();
+    }
+  }
+
+=head1 DESCRIPTION
+
+Provides an iterator for reading or writing message
+fields. This module provides a Perl API to access the
+dbus_message_iter_XXX methods in the C API. The array
+and dictionary types are not yet supported, and there
+are bugs in the Quad support (ie it always returns -1!).
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::Iterator;
+
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+
+our $have_quads = 0;
+
+BEGIN {
+  eval "pack 'Q', 1243456";
+  if ($@) {
+    $have_quads = 0;
+  } else {
+    $have_quads = 1;
+  }
+}
+
+=item $res = $iter->has_next()
+
+Determines if there are any more fields in the message
+itertor to be read. Returns a positive value if there
+are more fields, zero otherwise.
+
+=item $success = $iter->next()
+
+Skips the iterator onto the next field in the message.
+Returns a positive value if the current field pointer
+was successfully advanced, zero otherwise.
+
+=item my $val = $iter->get_boolean()
+
+=item $iter->append_boolean($val);
+
+Read or write a boolean value from/to the
+message iterator
+
+=item my $val = $iter->get_byte()
+
+=item $iter->append_byte($val);
+
+Read or write a single byte value from/to the
+message iterator.
+
+=item my $val = $iter->get_string()
+
+=item $iter->append_string($val);
+
+Read or write a UTF-8 string value from/to the
+message iterator
+
+=item my $val = $iter->get_object_path()
+
+=item $iter->append_object_path($val);
+
+Read or write a UTF-8 string value, whose contents is
+a valid object path, from/to the message iterator
+
+=item my $val = $iter->get_signature()
+
+=item $iter->append_signature($val);
+
+Read or write a UTF-8 string, whose contents is a 
+valid type signature, value from/to the message iterator
+
+=item my $val = $iter->get_int16()
+
+=item $iter->append_int16($val);
+
+Read or write a signed 16 bit value from/to the
+message iterator
+
+=item my $val = $iter->get_uint16()
+
+=item $iter->append_uint16($val);
+
+Read or write an unsigned 16 bit value from/to the
+message iterator
+
+=item my $val = $iter->get_int32()
+
+=item $iter->append_int32($val);
+
+Read or write a signed 32 bit value from/to the
+message iterator
+
+=item my $val = $iter->get_uint32()
+
+=item $iter->append_uint32($val);
+
+Read or write an unsigned 32 bit value from/to the
+message iterator
+
+=item my $val = $iter->get_int64()
+
+=item $iter->append_int64($val);
+
+Read or write a signed 64 bit value from/to the
+message iterator. An error will be raised if this
+build of Perl does not support 64 bit integers
+
+=item my $val = $iter->get_uint64()
+
+=item $iter->append_uint64($val);
+
+Read or write an unsigned 64 bit value from/to the
+message iterator. An error will be raised if this
+build of Perl does not support 64 bit integers
+
+=item my $val = $iter->get_double()
+
+=item $iter->append_double($val);
+
+Read or write a double precision floating point value 
+from/to the message iterator
+
+=cut
+
+sub get_int64 {
+    my $self = shift;
+    die "Quads not supported on this platform\n" unless $have_quads;
+    return $self->_get_int64;
+}
+
+sub get_uint64 {
+    my $self = shift;
+    die "Quads not supported on this platform\n" unless $have_quads;
+    return $self->_get_uint64;
+}
+
+sub append_int64 {
+    my $self = shift;
+    die "Quads not supported on this platform\n" unless $have_quads;
+    $self->_append_int64(shift);
+}
+
+sub append_uint64 {
+    my $self = shift;
+    die "Quads not supported on this platform\n" unless $have_quads;
+    $self->_append_uint64(shift);
+}
+
+=item my $value = $iter->get()
+
+=item my $value = $iter->get($type);
+
+Get the current value pointed to by this iterator. If the optional
+C<$type> parameter is supplied, the wire type will be compared with
+the desired type & a warning output if their differ. The C<$type>
+value must be one of the C<Net::DBus::Binding::Message::TYPE*>
+constants.
+
+=cut
+
+sub get {
+    my $self = shift;    
+    my $type = shift;
+
+    if (defined $type) {
+	if (ref($type)) {
+	    if (ref($type) eq "ARRAY") {
+		# XXX we should recursively validate types
+		$type = $type->[0];
+		if ($type eq &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
+		    $type = &Net::DBus::Binding::Message::TYPE_ARRAY;
+		}
+	    } else {
+		die "unsupport type reference $type";
+	    }
+	}
+
+	my $actual = $self->get_arg_type;
+	if ($actual != $type) {
+	    # "Be strict in what you send, be leniant in what you accept"
+	    #    - ie can't rely on python to send correct types, eg int32 vs uint32
+	    #die "requested type '" . chr($type) . "' ($type) did not match wire type '" . chr($actual) . "' ($actual)";
+	    warn "requested type '" . chr($type) . "' ($type) did not match wire type '" . chr($actual) . "' ($actual)";
+	    $type = $actual;
+	}
+    } else {
+	$type = $self->get_arg_type;
+    }
+
+	
+    
+    if ($type == &Net::DBus::Binding::Message::TYPE_STRING) {
+	return $self->get_string;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_BOOLEAN) {
+	return $self->get_boolean;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_BYTE) {
+	return $self->get_byte;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_INT16) {
+	return $self->get_int16;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT16) {
+	return $self->get_uint16;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_INT32) {
+	return $self->get_int32;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT32) {
+	return $self->get_uint32;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_INT64) {
+	return $self->get_int64;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT64) {
+	return $self->get_uint64;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_DOUBLE) {
+	return $self->get_double;
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_ARRAY) {
+	my $array_type = $self->get_element_type();
+	if ($array_type == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
+	    return $self->get_dict();
+	} else {
+	    return $self->get_array($array_type);
+	}
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_STRUCT) {
+	return $self->get_struct();
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_VARIANT) {
+	return $self->get_variant();
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
+	die "dictionary can only occur as part of an array type";
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_INVALID) {
+	die "cannot handle Net::DBus::Binding::Message::TYPE_INVALID";
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_OBJECT_PATH) {
+	return $self->get_object_path();
+    } elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
+	return $self->get_signature();
+    } else {
+	die "unknown argument type '" . chr($type) . "' ($type)";
+    }
+}
+
+=item my $hashref = $iter->get_dict()
+
+If the iterator currently points to a dictionary value, unmarshalls
+and returns the value as a hash reference. 
+
+=cut
+
+sub get_dict {
+    my $self = shift;
+    
+    my $iter = $self->_recurse();
+    my $type = $iter->get_arg_type();
+    my $dict = {};
+    while ($type == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
+	my $entry = $iter->get_struct();
+	if ($#{$entry} != 1) {
+	    die "Dictionary entries must be structs of 2 elements. This entry has " . ($#{$entry}+1) ." elements";
+	}
+	
+	$dict->{$entry->[0]} = $entry->[1];
+	$iter->next();
+	$type = $iter->get_arg_type();
+    }
+    return $dict;
+}
+
+=item my $hashref = $iter->get_array()
+
+If the iterator currently points to an array value, unmarshalls
+and returns the value as a array reference. 
+
+=cut
+
+sub get_array {
+    my $self = shift;
+    my $array_type = shift;
+    
+    my $iter = $self->_recurse();
+    my $type = $iter->get_arg_type();
+    my $array = [];
+    while ($type != &Net::DBus::Binding::Message::TYPE_INVALID) {
+	if ($type != $array_type) {
+	    die "Element $type not of array type $array_type";
+	}
+
+	my $value = $iter->get($type);
+	push @{$array}, $value;
+	$iter->next();
+	$type = $iter->get_arg_type();
+    }
+    return $array;
+}
+
+=item my $hashref = $iter->get_variant()
+
+If the iterator currently points to a variant value, unmarshalls
+and returns the value contained in the variant.
+
+=cut
+
+sub get_variant {
+    my $self = shift;
+
+    my $iter = $self->_recurse();
+    return $iter->get();
+}
+
+
+=item my $hashref = $iter->get_struct()
+
+If the iterator currently points to an struct value, unmarshalls
+and returns the value as a array reference. The values in the array 
+correspond to members of the struct.
+
+=cut
+
+sub get_struct {
+    my $self = shift;
+    
+    my $iter = $self->_recurse();
+    my $type = $iter->get_arg_type();
+    my $struct = [];
+    while ($type != &Net::DBus::Binding::Message::TYPE_INVALID) {
+	my $value = $iter->get($type);
+	push @{$struct}, $value;
+	$iter->next();
+	$type = $iter->get_arg_type();
+    }
+    return $struct;
+}
+
+=item $iter->append($value)
+
+=item $iter->append($value, $type)
+
+Appends a value to the message associated with this iterator. The
+value is marshalled into wire format, according to the following
+rules.
+
+If the C<$value> is an instance of L<Net::DBus::Binding::Value>,
+the embedded data type is used.
+
+If the C<$type> parameter is supplied, that is taken to represent
+the data type. The type must be one of the C<Net::DBus::Binding::Message::TYPE_*>
+constants.
+
+Otherwise, the data type is chosen to be a string, dict or array
+according to the perl data types SCALAR, HASH or ARRAY.
+
+=cut
+
+sub append {
+    my $self = shift;
+    my $value = shift;
+    my $type = shift;
+
+    if (ref($value) eq "Net::DBus::Binding::Value") {
+	$type = $value->type;
+	$value = $value->value;
+    }
+
+    if (!defined $type) {
+	$type = $self->guess_type($value);
+    }	
+
+    if (ref($type) eq "ARRAY") {
+	my $maintype = $type->[0];
+	my $subtype = $type->[1];
+
+	if ($maintype == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
+	    $self->append_dict($value, $subtype);
+	} elsif ($maintype == &Net::DBus::Binding::Message::TYPE_STRUCT) {
+	    $self->append_struct($value, $subtype);
+	} elsif ($maintype == &Net::DBus::Binding::Message::TYPE_ARRAY) {
+	    $self->append_array($value, $subtype);
+	} elsif ($maintype == &Net::DBus::Binding::Message::TYPE_VARIANT) {
+	    $self->append_variant($value, $subtype);
+	} else {
+	    die "Unsupported compound type ", $maintype, " ('", chr($maintype), "')";
+	}
+    } else {
+	# XXX is this good idea or not
+	$value = '' unless defined $value;
+
+	if ($type == &Net::DBus::Binding::Message::TYPE_BOOLEAN) {
+	    $self->append_boolean($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_BYTE) {
+	    $self->append_byte($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_STRING) {
+	    $self->append_string($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_INT16) {
+	    $self->append_int16($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT16) {
+	    $self->append_uint16($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_INT32) {
+	    $self->append_int32($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT32) {
+	    $self->append_uint32($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_INT64) {
+	    $self->append_int64($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT64) {
+	    $self->append_uint64($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_DOUBLE) {
+	    $self->append_double($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_OBJECT_PATH) {
+	    $self->append_object_path($value);
+	} elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
+	    $self->append_signature($value);
+	} else {
+	    die "Unsupported scalar type ", $type, " ('", chr($type), "')";
+	}
+    }
+}
+
+
+=item my $type = $iter->guess_type($value)
+
+Make a best guess at the on the wire data type to use for 
+marshalling C<$value>. If the value is a hash reference,
+the dictionary type is returned; if the value is an array
+reference the array type is returned; otherwise the string
+type is returned.
+
+=cut
+
+sub guess_type {
+    my $self = shift;
+    my $value = shift;
+
+    if (ref($value)) {
+	if (UNIVERSAL::isa($value, "Net::DBus::Binding::Value")) {
+	    my $type = $value->type;
+	    if (ref($type) && ref($type) eq "ARRAY") {
+		my $maintype = $type->[0];
+		my $subtype = $type->[1];
+
+		if (!defined $subtype) {
+		    if ($maintype == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
+			$subtype = [ $self->guess_type(($value->value())[0]->[0]), 
+				     $self->guess_type(($value->value())[0]->[1]) ];
+		    } elsif ($maintype == &Net::DBus::Binding::Message::TYPE_ARRAY) {
+			$subtype = [ $self->guess_type(($value->value())[0]->[0]) ];
+		    } elsif ($maintype == &Net::DBus::Binding::Message::TYPE_STRUCT) {
+			$subtype = [ map { $self->guess_type($_) } @{($value->value())[0]} ];
+		    } else {
+			die "Unguessable compound type '$maintype' ('", chr($maintype), "')\n";
+		    }
+		}
+		return [$maintype, $subtype];
+	    } else {
+		return $type;
+	    }
+	} elsif (ref($value) eq "HASH") {
+	    my $key = (keys %{$value})[0];
+	    my $val = $value->{$key};
+	    # XXX Basically impossible to decide between DICT & STRUCT
+	    return [ &Net::DBus::Binding::Message::TYPE_DICT_ENTRY,
+		     [ &Net::DBus::Binding::Message::TYPE_STRING, $self->guess_type($val)] ];
+	} elsif (ref($value) eq "ARRAY") {
+	    return [ &Net::DBus::Binding::Message::TYPE_ARRAY,
+		     [$self->guess_type($value->[0])] ];
+	} else {
+	    die "cannot marshall reference of type " . ref($value);
+	}
+    } else {
+	# XXX Should we bother trying to guess integer & floating point types ?
+	# I say sod it, because strongly typed languages will support introspection
+	# and loosely typed languages won't care about the difference
+	return &Net::DBus::Binding::Message::TYPE_STRING;
+    }
+}
+
+=item my $sig = $iter->format_signature($type)
+
+Given a data type representation, construct a corresponding 
+signature string
+
+=cut
+
+sub format_signature {
+    my $self = shift;
+    my $type = shift;
+    my ($sig, $t, $i);
+
+    $sig = "";
+    $i = 0;use Data::Dumper;
+
+    if (ref($type) eq "ARRAY") {
+	while ($i <= $#{$type}) {
+	    $t = $$type[$i];
+	    
+	    if (ref($t) eq "ARRAY") {
+		$sig .= $self->format_signature($t);
+	    } elsif ($t == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
+		$sig .= chr (&Net::DBus::Binding::Message::TYPE_ARRAY);
+		$sig .= "{" . $self->format_signature($$type[++$i]) . "}";
+	    } elsif ($t == &Net::DBus::Binding::Message::TYPE_STRUCT) {
+		$sig .= "(" . $self->format_signature($$type[++$i]) . ")";
+	    } else {
+		$sig .= chr($t);
+	    }
+	    
+	    $i++;
+	}
+    } else {
+	$sig .= chr ($type);
+    }
+    
+    return $sig;
+}
+
+=item $iter->append_array($value, $type)
+
+Append an array of values to the message. The C<$value> parameter
+must be an array reference, whose elements all have the same data
+type specified by the C<$type> parameter.
+
+=cut
+
+sub append_array {
+    my $self = shift;
+    my $array = shift;
+    my $type = shift;
+    
+    if (!defined($type)) {
+	$type = [$self->guess_type($array->[0])];
+    }
+
+    die "array must only have one type"
+	if $#{$type} > 0;
+
+    my $sig = $self->format_signature($type);
+    my $iter = $self->_open_container(&Net::DBus::Binding::Message::TYPE_ARRAY, $sig);
+    
+    foreach my $value (@{$array}) {
+	$iter->append($value, $type->[0]);
+    }
+
+    $self->_close_container($iter);
+}
+
+
+=item $iter->append_struct($value, $type)
+
+Append a struct to the message. The C<$value> parameter
+must be an array reference, whose elements correspond to
+members of the structure. The C<$type> parameter encodes
+the type of each member of the struct.
+
+=cut
+
+sub append_struct {
+    my $self = shift;
+    my $struct = shift;
+    my $type = shift;
+
+    if (defined($type) &&
+	$#{$struct} != $#{$type}) {
+	die "number of values does not match type";
+    }
+
+    my $iter = $self->_open_container(&Net::DBus::Binding::Message::TYPE_STRUCT, "");
+    
+    my @type = defined $type ? @{$type} : ();
+    foreach my $value (@{$struct}) {
+	$iter->append($value, shift @type);
+    }
+
+    $self->_close_container($iter);
+}
+
+=item $iter->append_dict($value, $type)
+
+Append a dictionary to the message. The C<$value> parameter
+must be an hash reference.The C<$type> parameter encodes
+the type of the key and value of the hash.
+
+=cut
+
+sub append_dict {
+    my $self = shift;
+    my $hash = shift;
+    my $type = shift;
+
+    my $sig;
+
+    $sig  = "{";
+    $sig .= $self->format_signature($type);
+    $sig .= "}";
+
+    my $iter = $self->_open_container(&Net::DBus::Binding::Message::TYPE_ARRAY, $sig);
+    
+    foreach my $key (keys %{$hash}) {
+	my $value = $hash->{$key};
+	my $entry = $iter->_open_container(&Net::DBus::Binding::Message::TYPE_DICT_ENTRY, $sig);
+
+	$entry->append($key, $type->[0]);
+	$entry->append($value, $type->[1]);
+	$iter->_close_container($entry);
+    }
+    $self->_close_container($iter);
+}
+
+=item $iter->append_variant($value)
+
+Append a value to the message, encoded as a variant type. The
+C<$value> can be of any type, however, the variant will be
+encoded as either a string, dictionary or array according to
+the rules of the C<guess_type> method.
+
+=cut
+
+sub append_variant {
+    my $self = shift;
+    my $value = shift;
+    my $type = shift;
+
+    if (UNIVERSAL::isa($value, "Net::DBus::Binding::Value")) {
+	$type = [$self->guess_type($value)];
+	$value = $value->value;
+    } elsif (!defined $type || !defined $type->[0]) {
+	$type = [$self->guess_type($value)];
+    }
+    die "variant must only have one type"
+	if defined $type && $#{$type} > 0;
+
+    my $sig = $self->format_signature($type->[0]);
+    my $iter = $self->_open_container(&Net::DBus::Binding::Message::TYPE_VARIANT, $sig);
+    $iter->append($value, $type->[0]);
+    $self->_close_container($iter);
+}
+
+
+=item my $type = $iter->get_arg_type
+
+Retrieves the type code of the value pointing to by this iterator.
+The returned code will correspond to one of the constants
+C<Net::DBus::Binding::Message::TYPE_*>
+
+=item my $type = $iter->get_element_type
+
+If the iterator points to an array, retrieves the type code of 
+array elements. The returned code will correspond to one of the 
+constants C<Net::DBus::Binding::Message::TYPE_*>
+
+=cut
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Message>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan@berrange.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Daniel Berrange
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Makefile.am b/Net-DBus/lib/Net/DBus/Binding/Makefile.am
new file mode 100644
index 0000000..7be850f
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Makefile.am
@@ -0,0 +1,13 @@
+SUBDIRS = Message
+
+EXTRA_DIST = \
+	Bus.pm \
+	Connection.pm \
+	Introspector.pm \
+	Iterator.pm \
+	Message \
+	Message.pm \
+	PendingCall.pm \
+	Server.pm \
+	Value.pm \
+	Watch.pm
diff --git a/Net-DBus/lib/Net/DBus/Binding/Message.pm b/Net-DBus/lib/Net/DBus/Binding/Message.pm
new file mode 100644
index 0000000..69a9254
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Message.pm
@@ -0,0 +1,462 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Message - Base class for messages
+
+=head1 SYNOPSIS
+
+Sending a message
+
+  my $msg = new Net::DBus::Binding::Message::Signal;
+  my $iterator = $msg->iterator;
+
+  $iterator->append_byte(132);
+  $iterator->append_int32(14241);
+
+  $connection->send($msg);
+
+=head1 DESCRIPTION
+
+Provides a base class for the different kinds of
+message that can be sent/received. Instances of
+this class are never instantiated directly, rather
+one of the four sub-types L<Net::DBus::Binding::Message::Signal>,
+L<Net::DBus::Binding::Message::MethodCall>, L<Net::DBus::Binding::Message::MethodReturn>,
+L<Net::DBus::Binding::Message::Error> should be used.
+
+=head1 CONSTANTS
+
+The following constants are defined in this module. They are
+not exported into the caller's namespace & thus must be referenced
+with their fully qualified package names
+
+=over 4
+
+=item TYPE_ARRAY
+
+Constant representing the signature value associated with the
+array data type.
+
+=item TYPE_BOOLEAN
+
+Constant representing the signature value associated with the
+boolean data type.
+
+=item TYPE_BYTE
+
+Constant representing the signature value associated with the
+byte data type.
+
+=item TYPE_DICT_ENTRY
+
+Constant representing the signature value associated with the
+dictionary entry data type.
+
+=item TYPE_DOUBLE
+
+Constant representing the signature value associated with the
+IEEE double precision floating point data type.
+
+=item TYPE_INT16
+
+Constant representing the signature value associated with the
+signed 16 bit integer data type.
+
+=item TYPE_INT32
+
+Constant representing the signature value associated with the
+signed 32 bit integer data type.
+
+=item TYPE_INT64
+
+Constant representing the signature value associated with the
+signed 64 bit integer data type.
+
+=item TYPE_OBJECT_PATH
+
+Constant representing the signature value associated with the
+object path data type.
+
+=item TYPE_STRING
+
+Constant representing the signature value associated with the
+UTF-8 string data type.
+
+=item TYPE_SIGNATURE
+
+Constant representing the signature value associated with the
+signature data type.
+
+=item TYPE_STRUCT
+
+Constant representing the signature value associated with the
+struct data type.
+
+=item TYPE_UINT16
+
+Constant representing the signature value associated with the
+unsigned 16 bit integer data type.
+
+=item TYPE_UINT32
+
+Constant representing the signature value associated with the
+unsigned 32 bit integer data type.
+
+=item TYPE_UINT64
+
+Constant representing the signature value associated with the
+unsigned 64 bit integer data type.
+
+=item TYPE_VARIANT
+
+Constant representing the signature value associated with the
+variant data type.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::Message;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus::Binding::Iterator;
+use Net::DBus::Binding::Message::Signal;
+use Net::DBus::Binding::Message::MethodCall;
+use Net::DBus::Binding::Message::MethodReturn;
+use Net::DBus::Binding::Message::Error;
+
+=item my $msg = Net::DBus::Binding::Message->new(message => $rawmessage);
+
+Creates a new message object, initializing it with the underlying C
+message object given by the C<message> object. This constructor is
+intended for internal use only, instead refer to one of the four
+sub-types for this class for specific message types
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+    my $self = {};
+
+    $self->{message} = exists $params{message} ? $params{message} : 
+	(Net::DBus::Binding::Message::_create(exists $params{type} ? $params{type} : die "type parameter is required"));
+
+    bless $self, $class;
+    
+    if ($class eq "Net::DBus::Binding::Message") {
+	$self->_specialize;
+    }
+
+    return $self;
+}
+
+sub _specialize {
+    my $self = shift;
+    
+    my $type = $self->get_type;
+    if ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_CALL) {
+	bless $self, "Net::DBus::Binding::Message::MethodCall";
+    } elsif ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN) {
+	bless $self, "Net::DBus::Binding::Message::MethodReturn";
+    } elsif ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_ERROR) {
+	bless $self, "Net::DBus::Binding::Message::Error";
+    } elsif ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_SIGNAL) {
+	bless $self, "Net::DBus::Binding::Message::Signal";
+    } else {
+	warn "Unknown message type $type\n";
+    }
+}
+
+=item my $type = $msg->get_type
+
+Retrieves the type code for this message. The returned value corresponds
+to one of the four C<Net::DBus::Binding::Message::MESSAGE_TYPE_*> constants.
+
+=cut
+
+sub get_type {
+    my $self = shift;
+
+    return $self->{message}->dbus_message_get_type;
+}
+
+=item my $interface = $msg->get_interface
+
+Retrieves the name of the interface targetted by this message, possibly
+an empty string if there is no applicable interface for this message.
+
+=cut
+
+sub get_interface {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_interface;
+}
+
+=item my $path = $msg->get_path
+
+Retrieves the object path associated with the message, possibly an
+empty string if there is no applicable object for this message.
+
+=cut
+
+sub get_path {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_path;
+}
+
+=item my $name = $msg->get_destination
+
+Retrieves the uniqe or well-known bus name for client intended to be
+the recipient of the message. Possibly returns an empty string if
+the message is being broadcast to all clients.
+
+=cut
+
+sub get_destination {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_destination;
+}
+
+=item my $name = $msg->get_sender
+
+Retireves the unique name of the client sending the message
+
+=cut
+
+sub get_sender {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_sender;
+}
+
+=item my $serial = $msg->get_serial
+
+Retrieves the unique serial number of this message. The number
+is guarenteed unique for as long as the connection over which
+the message was sent remains open. May return zero, if the message
+is yet to be sent.
+
+=cut
+
+sub get_serial {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_serial;
+}
+
+=item my $name = $msg->get_member
+
+For method calls, retrieves the name of the method to be invoked,
+while for signals, retrieves the name of the signal.
+
+=cut
+
+sub get_member {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_member;
+}
+
+=item my $sig = $msg->get_signature
+
+Retrieves a string representing the type signature of the values
+packed into the body of the message.
+
+=cut
+
+sub get_signature {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_signature;
+}
+
+=item $msg->set_sender($name)
+
+Set the name of the client sending the message. The name must
+be the unique name of the client.
+
+=cut
+
+sub set_sender {
+    my $self = shift;
+    $self->{message}->dbus_message_set_sender(@_);
+}
+
+=item $msg->set_destination($name)
+
+Set the name of the intended recipient of the message. This is
+typically used for signals to switch them from broadcast to
+unicast.
+
+=cut
+
+sub set_destination {
+    my $self = shift;
+    $self->{message}->dbus_message_set_destination(@_);
+}
+
+=item my $iterator = $msg->iterator;
+
+Retrieves an iterator which can be used for reading or
+writing fields of the message. The returned object is
+an instance of the C<Net::DBus::Binding::Iterator> class.
+
+=cut
+
+sub iterator {
+    my $self = shift;
+    my $append = @_ ? shift : 0;
+    
+    if ($append) {
+	return Net::DBus::Binding::Message::_iterator_append($self->{message});
+    } else {
+	return Net::DBus::Binding::Message::_iterator($self->{message});
+    }
+}
+
+=item $boolean = $msg->get_no_reply()
+
+Gets the flag indicating whether the message is expecting
+a reply to be sent. 
+
+=cut
+
+sub get_no_reply {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_no_reply;
+}
+
+=item $msg->set_no_reply($boolean)
+
+Toggles the flag indicating whether the message is expecting
+a reply to be sent. All method call messages expect a reply
+by default. By toggling this flag the communication latency
+is reduced by removing the need for the client to wait
+
+=cut
+
+
+sub set_no_reply {
+    my $self = shift;
+    my $flag = shift;
+    
+    $self->{message}->dbus_message_set_no_reply($flag);
+}
+
+=item my @values = $msg->get_args_list
+
+De-marshall all the values in the body of the message, using the 
+message signature to identify data types. The values are returned
+as a list.
+
+=cut
+
+sub get_args_list {
+    my $self = shift;
+    
+    my @ret;    
+    my $iter = $self->iterator;
+    if ($iter->get_arg_type() != &Net::DBus::Binding::Message::TYPE_INVALID) {
+	do {
+	    push @ret, $iter->get();
+	} while ($iter->next);
+    }
+
+    return @ret;
+}
+
+=item $msg->append_args_list(@values)
+
+Append a set of values to the body of the message. Values will
+be encoded as either a string, list or dictionary as appropriate
+to their Perl data type. For more specific data typing needs,
+the L<Net::DBus::Binding::Iterator> object should be used instead.
+
+=cut
+
+sub append_args_list {
+    my $self = shift;
+    my @args = @_;
+    
+    my $iter = $self->iterator(1);
+    foreach my $arg (@args) {
+	$iter->append($arg);
+    }
+}
+
+# To keep autoloader quiet
+sub DESTROY {
+}
+
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.
+
+    my $constname;
+    our $AUTOLOAD;
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+
+    die "&Net::DBus::Binding::Message::constant not defined" if $constname eq '_constant';
+
+    if (!exists $Net::DBus::Binding::Message::_constants{$constname}) {
+        die "no such constant \$Net::DBus::Binding::Message::$constname";
+    }
+
+    {
+	no strict 'refs';
+	*$AUTOLOAD = sub { $Net::DBus::Binding::Message::_constants{$constname} };
+    }
+    goto &$AUTOLOAD;
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Server>, L<Net::DBus::Binding::Connection>, L<Net::DBus::Binding::Message::Signal>, L<Net::DBus::Binding::Message::MethodCall>, L<Net::DBus::Binding::Message::MethodReturn>, L<Net::DBus::Binding::Message::Error>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan@berrange.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Daniel Berrange
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Message/Error.pm b/Net-DBus/lib/Net/DBus/Binding/Message/Error.pm
new file mode 100644
index 0000000..c4c9337
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Message/Error.pm
@@ -0,0 +1,124 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Message::Error - a message encoding a method call error
+
+=head1 SYNOPSIS
+
+  use Net::DBus::Binding::Message::Error;
+
+  my $error = Net::DBus::Binding::Message::Error->new(
+      replyto => $method_call,
+      name => "org.example.myobject.FooException",
+      description => "Unable to do Foo when updating bar");
+
+  $connection->send($error);
+
+=head1 DESCRIPTION
+
+This module is part of the low-level DBus binding APIs, and
+should not be used by application code. No guarentees are made
+about APIs under the C<Net::DBus::Binding::> namespace being
+stable across releases.
+
+This module provides a convenience constructor for creating
+a message representing an error condition. 
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::Message::Error;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+use base qw(Net::DBus::Binding::Message);
+
+=item my $error = Net::DBus::Binding::Message::Error->new(
+      replyto => $method_call, name => $name, description => $description);
+
+Creates a new message, representing an error which occurred during
+the handling of the method call object passed in as the C<replyto>
+parameter. The C<name> parameter is the formal name of the error
+condition, while the C<description> is a short piece of text giving
+more specific information on the error.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+
+    my $replyto = exists $params{replyto} ? $params{replyto} : die "replyto parameter is required";
+
+    my $msg = exists $params{message} ? $params{message} : 
+	Net::DBus::Binding::Message::Error::_create
+	(
+	 $replyto->{message},
+	 ($params{name} ? $params{name} : die "name parameter is required"),
+	 ($params{description} ? $params{description} : die "description parameter is required"));
+
+    my $self = $class->SUPER::new(message => $msg);
+
+    bless $self, $class;
+    
+    return $self;
+}
+
+=item my $name = $error->get_error_name
+
+Returns the formal name of the error, as previously passed in via
+the C<name> parameter in the constructor.
+
+=cut
+
+sub get_error_name {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_error_name;
+}
+
+1;
+
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Daniel P. Berrange.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005-2006 Daniel P. Berrange
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Message>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Message/Makefile.am b/Net-DBus/lib/Net/DBus/Binding/Message/Makefile.am
new file mode 100644
index 0000000..b1e0dc5
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Message/Makefile.am
@@ -0,0 +1,5 @@
+EXTRA_DIST = \
+	Error.pm \
+	MethodCall.pm \
+	MethodReturn.pm \
+	Signal.pm
diff --git a/Net-DBus/lib/Net/DBus/Binding/Message/MethodCall.pm b/Net-DBus/lib/Net/DBus/Binding/Message/MethodCall.pm
new file mode 100644
index 0000000..6e68255
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Message/MethodCall.pm
@@ -0,0 +1,101 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Message::MethodCall - a message encoding a method call
+
+=head1 DESCRIPTION
+
+This module is part of the low-level DBus binding APIs, and
+should not be used by application code. No guarentees are made
+about APIs under the C<Net::DBus::Binding::> namespace being
+stable across releases.
+
+This module provides a convenience constructor for creating
+a message representing a method call. 
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+
+package Net::DBus::Binding::Message::MethodCall;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+use base qw(Exporter Net::DBus::Binding::Message);
+
+=item my $call = Net::DBus::Binding::Message::MethodCall->new(
+  service_name => $service, object_path => $object, 
+  interface => $interface, method_name => $name);
+
+Create a message representing a call on the object located at
+the path C<object_path> within the client owning the well-known
+name given by C<service_name>. The method to be invoked has
+the name C<method_name> within the interface specified by the
+C<interface> parameter.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+
+    my $msg = exists $params{message} ? $params{message} :
+	Net::DBus::Binding::Message::MethodCall::_create
+	(
+	 ($params{service_name} ? $params{service_name} : die "service_name parameter is required"),
+	 ($params{object_path} ? $params{object_path} : die "object_path parameter is required"),
+	 ($params{interface} ? $params{interface} : die "interface parameter is required"),
+	 ($params{method_name} ? $params{method_name} : die "method_name parameter is required"));
+
+    my $self = $class->SUPER::new(message => $msg);
+
+    bless $self, $class;
+    
+    return $self;
+}
+
+1;
+
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Daniel P. Berrange.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005-2006 Daniel P. Berrange
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Message>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Message/MethodReturn.pm b/Net-DBus/lib/Net/DBus/Binding/Message/MethodReturn.pm
new file mode 100644
index 0000000..2a57764
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Message/MethodReturn.pm
@@ -0,0 +1,93 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Message::MethodReturn - a message encoding a method return
+
+=head1 DESCRIPTION
+
+This module is part of the low-level DBus binding APIs, and
+should not be used by application code. No guarentees are made
+about APIs under the C<Net::DBus::Binding::> namespace being
+stable across releases.
+
+This module provides a convenience constructor for creating
+a message representing an method return.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::Message::MethodReturn;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+use base qw(Exporter Net::DBus::Binding::Message);
+
+=item my $return = Net::DBus::Binding::Message::MethodReturn->new(
+    call => $method_call);
+
+Create a message representing a reply to the method call passed in
+the C<call> parameter.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+
+    my $call = exists $params{call} ? $params{call} : die "call parameter is required";
+    
+    my $msg = exists $params{message} ? $params{message} : 
+	Net::DBus::Binding::Message::MethodReturn::_create($call->{message});
+
+    my $self = $class->SUPER::new(message => $msg);
+
+    bless $self, $class;
+    
+    return $self;
+}
+
+1;
+
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Daniel P. Berrange.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005-2006 Daniel P. Berrange
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Message>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Message/Signal.pm b/Net-DBus/lib/Net/DBus/Binding/Message/Signal.pm
new file mode 100644
index 0000000..caa7387
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Message/Signal.pm
@@ -0,0 +1,111 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Message::Signal - a message encoding a signal
+
+=head1 SYNOPSIS
+
+  use Net::DBus::Binding::Message::Signal;
+
+  my $signal = Net::DBus::Binding::Message::Signal->new(
+      object_path => "/org/example/myobject",
+      interface => "org.example.myobject",
+      signal_name => "foo_changed");
+
+  $connection->send($signal);
+
+=head1 DESCRIPTION
+
+This module is part of the low-level DBus binding APIs, and
+should not be used by application code. No guarentees are made
+about APIs under the C<Net::DBus::Binding::> namespace being
+stable across releases.
+
+This module provides a convenience constructor for creating
+a message representing a signal. 
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::Message::Signal;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+use base qw(Net::DBus::Binding::Message);
+
+
+=item my $signal = Net::DBus::Binding::Message::Signal->new(
+      object_path => $path, interface => $interface, signal_name => $name);
+
+Creates a new message, representing a signal [to be] emitted by 
+the object located under the path given by the C<object_path>
+parameter. The name of the signal is given by the C<signal_name>
+parameter, and is scoped to the interface given by the
+C<interface> parameter.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+
+    my $msg = exists $params{message} ? $params{message} :
+	Net::DBus::Binding::Message::Signal::_create
+	(
+	 ($params{object_path} ? $params{object_path} : die "object_path parameter is required"),
+	 ($params{interface} ? $params{interface} : die "interface parameter is required"),
+	 ($params{signal_name} ? $params{signal_name} : die "signal_name parameter is required"));
+
+    my $self = $class->SUPER::new(message => $msg);
+
+    bless $self, $class;
+    
+    return $self;
+}
+
+
+1;
+
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Daniel P. Berrange.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005-2006 Daniel P. Berrange
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Message>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/PendingCall.pm b/Net-DBus/lib/Net/DBus/Binding/PendingCall.pm
new file mode 100644
index 0000000..e061359
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/PendingCall.pm
@@ -0,0 +1,179 @@
+# -*- perl -*-
+#
+# Copyright (C) 2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::PendingCall - A handler for pending method replies
+
+=head1 SYNOPSIS
+
+  my $call = Net::DBus::Binding::PendingCall->new(method_call => $call,
+                                                  pending_call => $reply);
+
+  # Wait for completion
+  $call->block;
+
+  # And get the reply message
+  my $msg = $call->get_reply;
+
+=head1 DESCRIPTION
+
+This object is used when it is neccessary to make asynchronous method
+calls. It provides the means to be notified when the reply is finally
+received.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::PendingCall;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+use Net::DBus::Binding::Message::MethodReturn;
+use Net::DBus::Binding::Message::Error;
+
+=item my $call = Net::DBus::Binding::PendingCall->new(method_call => $method_call,
+                                                      pending_call => $pending_call);
+
+Creates a new pending call object, with the C<method_call> parameter
+being a reference to the C<Net::DBus::Binding::Message::MethodCall>
+object whose reply is being waiting for. The C<pending_call> parameter
+is a reference to the raw C pending call object.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+    my $self = {};
+
+    $self->{connection} = exists $params{connection} ? $params{connection} : die "connection parameter is required";
+    $self->{method_call} = exists $params{method_call} ? $params{method_call} : die "method_call parameter is required";
+    $self->{pending_call} = exists $params{pending_call} ? $params{pending_call} : die "pending_call parameter is required";
+
+    bless $self, $class;
+
+    return $self;
+}
+
+=item $call->cancel
+
+Cancel the pending call, causing any reply that is later received
+to be discarded.
+
+=cut
+
+sub cancel {
+    my $self = shift;
+
+    $self->{pending_call}->dbus_pending_call_cancel();
+}
+
+
+=item my $boolean = $call->get_completed
+
+Returns a true value if the pending call has received its reply,
+or a timeout has occurred.
+
+=cut
+
+sub get_completed {
+    my $self = shift;
+
+    $self->{pending_call}->dbus_pending_call_get_completed();
+}
+
+=item $call->block
+
+Block the caller until the reply is recieved or a timeout
+occurrs.
+
+=cut
+
+sub block {
+    my $self = shift;
+
+    $self->{pending_call}->dbus_pending_call_block();
+}
+
+=item my $msg = $call->get_reply;
+
+Retrieves the C<Net::DBus::Binding::Message> object associated
+with the complete call.
+
+=cut
+
+sub get_reply {
+    my $self = shift;
+
+    my $reply = $self->{pending_call}->dbus_pending_call_steal_reply();
+    my $type = $reply->dbus_message_get_type;
+    if ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_ERROR) {
+	return $self->{connection}->make_error_message($self->{method_call},
+						       $reply);
+    } elsif ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN) {
+	return $self->{connection}->make_method_return_message($self->{method_call},
+							       $reply);
+    } else {
+	die "unknown method reply type $type";
+    }
+}
+
+=item $call->set_notify($coderef);
+
+Sets a notification function to be invoked when the pending
+call completes. The callback will be passed a single argument
+which is this pending call object.
+
+=cut
+
+sub set_notify {
+    my $self = shift;
+    my $cb = shift;
+
+    $self->{pending_call}->_set_notify($cb);
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Connection>, L<Net::DBus::Binding::Message>, L<Net::DBus::ASyncReply>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan@berrange.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2006 by Daniel Berrange
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Server.pm b/Net-DBus/lib/Net/DBus/Binding/Server.pm
new file mode 100644
index 0000000..b999f24
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Server.pm
@@ -0,0 +1,232 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Server - A server to accept incoming connections
+
+=head1 SYNOPSIS
+
+Creating a new server and accepting client connections
+
+  use Net::DBus::Binding::Server;
+
+  my $server = Net::DBus::Binding::Server->new(address => "unix:path=/path/to/socket");
+
+  $server->connection_callback(\&new_connection);
+
+  sub new_connection {
+      my $connection = shift;
+
+      .. work with new connection...
+  }
+
+Managing the server and new connections in an event loop
+
+  my $reactor = Net::DBus::Binding::Reactor->new();
+
+  $reactor->manage($server);
+  $reactor->run();
+
+  sub new_connection {
+      my $connection = shift;
+
+      $reactor->manage($connection);
+  }
+
+
+=head1 DESCRIPTION
+
+A server for receiving connection from client programs.
+The methods defined on this module have a close
+correspondance to the dbus_server_XXX methods in the C API,
+so for further details on their behaviour, the C API documentation
+may be of use.
+
+=head1 METHODS
+
+=over 
+
+=cut
+
+package Net::DBus::Binding::Server;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+use Net::DBus::Binding::Connection;
+
+=item my $server = Net::DBus::Binding::Server->new(address => "unix:path=/path/to/socket");
+
+Creates a new server binding it to the socket specified by the
+C<address> parameter.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+    my $self = {};
+
+    $self->{address} = exists $params{address} ? $params{address} : die "address parameter is required";
+    $self->{server} = Net::DBus::Binding::Server::_open($self->{address});
+
+    bless $self, $class;
+
+    $self->{server}->_set_owner($self);
+
+    $self->{_callback} = sub {
+	my $server = shift;
+	my $rawcon = shift;
+	my $con = Net::DBus::Binding::Connection->new(connection => $rawcon);
+
+	if ($server->{connection_callback}) {
+	    &{$server->{connection_callback}}($server, $con);
+	}
+    };
+
+    return $self;
+}
+
+=item $status = $server->is_connected();
+
+Returns zero if the server has been disconnected,
+otherwise a positive value is returned.
+
+=cut
+
+
+sub is_connected {
+    my $self = shift;
+    
+    return $self->{server}->dbus_server_get_is_connected();
+}
+
+=item $server->disconnect()
+
+Closes this server to the remote host. This method
+is called automatically during garbage collection (ie
+in the DESTROY method) if the programmer forgets to
+explicitly disconnect.
+
+=cut
+
+sub disconnect {
+    my $self = shift;
+    
+    return $self->{server}->dbus_server_disconnect();
+}
+
+
+=item $server->set_watch_callbacks(\&add_watch, \&remove_watch, \&toggle_watch);
+
+Register a set of callbacks for adding, removing & updating 
+watches in the application's event loop. Each parameter
+should be a code reference, which on each invocation, will be
+supplied with two parameters, the server object and the
+watch object. If you are using a C<Net::DBus::Binding::Reactor> object
+as the application event loop, then the 'manage' method on
+that object will call this on your behalf.
+
+=cut
+
+
+sub set_watch_callbacks {
+    my $self = shift;
+    my $add = shift;
+    my $remove = shift;
+    my $toggled = shift;
+
+    $self->{add_watch} = $add;
+    $self->{remove_watch} = $remove;
+    $self->{toggled_watch} = $toggled;
+
+    $self->{server}->_set_watch_callbacks();
+}
+
+=item $server->set_timeout_callbacks(\&add_timeout, \&remove_timeout, \&toggle_timeout);
+
+Register a set of callbacks for adding, removing & updating 
+timeouts in the application's event loop. Each parameter
+should be a code reference, which on each invocation, will be
+supplied with two parameters, the server object and the
+timeout object. If you are using a C<Net::DBus::Binding::Reactor> object
+as the application event loop, then the 'manage' method on
+that object will call this on your behalf.
+
+=cut
+
+sub set_timeout_callbacks {
+    my $self = shift;
+    my $add = shift;
+    my $remove = shift;
+    my $toggled = shift;
+
+    $self->{add_timeout} = $add;
+    $self->{remove_timeout} = $remove;
+    $self->{toggled_timeout} = $toggled;
+
+    $self->{server}->_set_timeout_callbacks();
+}
+
+=item $server->set_connection_callback(\&handler)
+
+Registers the handler to use for dealing with
+new incoming connections from clients. The code
+reference will be invoked each time a new client
+connects and supplied with a single parameter
+which is the C<Net::DBus::Binding::Connection> object representing
+the client.
+
+=cut
+
+sub set_connection_callback {
+    my $self = shift;
+    my $callback = shift;
+
+    $self->{connection_callback} = $callback;
+
+    $self->{server}->_set_connection_callback();
+}
+
+
+1;
+
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Connection>, L<Net::DBus::Binding::Bus>, L<Net::DBus::Binding::Message::Signal>, L<Net::DBus::Binding::Message::MethodCall>, L<Net::DBus::Binding::Message::MethodReturn>, L<Net::DBus::Binding::Message::Error>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan@berrange.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Daniel Berrange
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Value.pm b/Net-DBus/lib/Net/DBus/Binding/Value.pm
new file mode 100644
index 0000000..b282b99
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Value.pm
@@ -0,0 +1,115 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Value - Strongly typed data value
+
+=head1 SYNOPSIS
+
+  # Import the convenience functions
+  use Net::DBus qw(:typing);
+
+  # Call a method with passing an int32
+  $object->doit(dint32("3"));
+
+=head1 DESCRIPTION
+
+This module provides a simple wrapper around a raw Perl value,
+associating an explicit DBus type with the value. This is used
+in cases where a client is communicating with a server which does
+not provide introspection data, but for which the basic data types
+are not sufficient. This class should not be used directly, rather
+the convenience functions in L<Net::DBus> be called.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::Value;
+
+use strict;
+use warnings;
+
+=item my $value = Net::DBus::Binding::Value->new($type, $value);
+
+Creates a wrapper for the perl value C<$value> marking it as having
+the dbus data type C<$type>. It is not neccessary to call this method
+directly, instead the data typing methods in the L<Net::DBus> object
+should be used.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $self = [];
+    
+    $self->[0] = shift;
+    $self->[1] = shift;
+    
+    bless $self, $class;
+
+    return $self;
+}
+
+=item my $raw = $value->value
+
+Returns the raw perl value wrapped by this object
+
+=cut
+
+sub value {
+    my $self = shift;
+    return $self->[1];
+}
+
+=item my $type = $value->type
+
+Returns the dbus data type this value is marked
+as having
+
+=cut
+
+sub type {
+    my $self = shift;
+    return $self->[0];
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::Binding::Introspector>, L<Net::DBus::Binding::Iterator>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan@berrange.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004-2005 by Daniel Berrange
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Binding/Watch.pm b/Net-DBus/lib/Net/DBus/Binding/Watch.pm
new file mode 100644
index 0000000..3d2591c
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Binding/Watch.pm
@@ -0,0 +1,73 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Watch - binding to the dbus watch API
+
+=cut
+
+package Net::DBus::Binding::Watch;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus;
+
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.
+
+    my $constname;
+    our $AUTOLOAD;
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+
+    die "&Net::DBus::Binding::Watch::constant not defined" if $constname eq '_constant';
+
+    if (!exists $Net::DBus::Binding::Watch::_constants{$constname}) {
+        die "no such constant \$Net::DBus::Binding::Watch::$constname";
+    }
+
+    {
+	no strict 'refs';
+	*$AUTOLOAD = sub { $Net::DBus::Binding::Watch::_constants{$constname} };
+    }
+    goto &$AUTOLOAD;
+}
+
+1;
+
+=pod
+
+=head1 AUTHOR
+
+Daniel P. Berrange.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2004-2006 Daniel P. Berrange
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Connection>
+
+=cut
+
diff --git a/Net-DBus/lib/Net/DBus/Callback.pm b/Net-DBus/lib/Net/DBus/Callback.pm
new file mode 100644
index 0000000..40b8131
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Callback.pm
@@ -0,0 +1,139 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Callback - a callback for receiving reactor events
+
+=head1 SYNOPSIS
+
+  use Net::DBus::Callback;
+
+  # Assume we have a 'terminal' object and its got a method
+  # to be invoked everytime there is input on its terminal.
+  #
+  # To create a callback to invoke this method one might use
+  my $cb = Net::DBus::Callback->new(object => $terminal,
+                                    method => "handle_stdio");
+
+
+  # Whatever is monitoring the stdio channel, would then
+  # invoke the callback, perhaps passing in a parameter with
+  # some 'interesting' data, such as number of bytes available
+  $cb->invoke($nbytes)
+
+  #... which results in a call to
+  #  $terminal->handle_stdio($nbytes)
+
+=head1 DESCRIPTION
+
+This module provides a simple container for storing details
+about a callback to be invoked at a later date. It is used
+when registering to receive events from the L<Net::DBus::Reactor>
+class
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Callback;
+
+use 5.006;
+use strict;
+use warnings;
+
+=item my $cb = Net::DBus::Callback->new(method => $name, [args => \@args])
+
+Creates a new callback object, for invoking a plain old function. The C<method>
+parameter should be the fully qualified function name to invoke, including the
+package name. The optional C<args> parameter is an array reference of parameters
+to be pass to the callback, in addition to those passed into the C<invoke> method.
+
+=item my $cb = Net::DBus::Callback->new(object => $object, method => $name, [args => \@args])
+
+Creates a new callback object, for invoking a method on an object. The C<method>
+parameter should be the name of the method to invoke, while the C<object> parameter
+should be a blessed object on which the method will be invoked. The optional C<args> 
+parameter is an array reference of parameters to be pass to the callback, in addition 
+to those passed into the C<invoke> method.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+    my $self = {};
+
+    $self->{object} = $params{object} ? $params{object} : undef;
+    $self->{method} = $params{method} ? $params{method} : die "method parameter is required";
+    $self->{args} = $params{args} ? $params{args} : [];
+
+    bless $self, $class;
+
+    return $self;
+}
+
+=item $cb->invoke(@args)
+
+Invokes the callback. The argument list passed to the callback
+is a combination of the arguments supplied in the callback
+constructor, followed by the arguments supplied in the C<invoke>
+method.
+
+=cut
+
+sub invoke {
+    my $self = shift;
+    
+    if ($self->{object}) {
+	my $obj = $self->{object};
+	my $method = $self->{method};
+
+	$obj->$method(@{$self->{args}}, @_);
+    } else {
+	my $method = $self->{method};
+
+	&$method(@{$self->{args}}, @_);
+    }
+}
+
+1;
+
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Daniel P. Berrange.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2004-2006 Daniel P. Berrange
+
+=head1 SEE ALSO
+
+L<Net::DBus::Reactor>
+
+=cut
+
diff --git a/Net-DBus/lib/Net/DBus/Dumper.pm b/Net-DBus/lib/Net/DBus/Dumper.pm
new file mode 100644
index 0000000..90b8871
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Dumper.pm
@@ -0,0 +1,233 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Dumper - Stringify Net::DBus objects suitable for printing
+
+=head1 SYNOPSIS
+
+  use Net::DBus::Dumper;
+
+  use Net::DBus;
+
+  # Dump out info about the bus
+  my $bus = Net::DBus->find;
+  print dbus_dump($bus);
+
+  # Dump out info about a service
+  my $service = $bus->get_service("org.freedesktop.DBus");
+  print dbus_dump($service);
+
+  # Dump out info about an object
+  my $object = $service->get_object("/org/freedesktop/DBus");
+  print dbus_dump($object);
+
+=head1 DESCRIPTION
+
+This module serves as a debugging aid, providing a means to stringify
+a DBus related object in a form suitable for printing out. It can 
+stringify any of the Net::DBus:* objects, generating the following
+information for each
+
+=over 4
+
+=item Net::DBus
+
+A list of services registered with the bus
+
+=item Net::DBus::Service
+=item Net::DBus::RemoteService
+
+The service name
+
+=item Net::DBus::Object
+=item Net::DBus::RemoteObject
+
+The list of all exported methods, and signals, along with their
+parameter and return types.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Dumper;
+
+use strict;
+use warnings;
+
+use Exporter;
+
+use vars qw(@EXPORT);
+
+@EXPORT = qw(dbus_dump);
+
+
+=item my @data = dbus_dump($object);
+
+Generates a stringified representation of an object. The object
+passed in as the parameter must be an instance of one of L<Net::DBus>, 
+L<Net::DBus::RemoteService>, L<Net::DBus::Service>,
+L<Net::DBus::RemoteObject>, L<Net::DBus::Object>. The stringified
+representation will be returned as a list of strings, with newlines
+in appropriate places, such that it can be passed string to the C<print>
+method.
+
+=cut
+
+sub dbus_dump {
+    my $object = shift;
+    
+    my $ref = ref($object);
+    die "object '$object' is not a reference" unless defined $ref;
+    
+    if ($object->isa("Net::DBus::Object") ||
+	$object->isa("Net::DBus::RemoteObject")) {
+	return &_dbus_dump_introspector($object->_introspector);
+    } elsif ($object->isa("Net::DBus::RemoteService") ||
+	     $object->isa("Net::DBus::Service")) {
+	return &_dbus_dump_service($object);
+    } elsif ($object->isa("Net::DBus")) {
+	return &_dbus_dump_bus($object);
+    }
+}
+
+
+sub _dbus_dump_introspector {
+    my $ins = shift;
+    
+    my @data;
+    push @data, "Object: ", $ins->get_object_path, "\n";
+    foreach my $interface ($ins->list_interfaces) {
+	push @data, "  Interface: ", $interface, "\n";
+	foreach my $method ($ins->list_methods($interface)) {
+	    push @data, "    Method: ", $method, "\n";
+	    foreach my $param ($ins->get_method_params($interface, $method)) {
+		push @data, &_dbus_dump_types("      > ", $param);
+	    }
+	    foreach my $param ($ins->get_method_returns($interface, $method)) {
+		push @data, &_dbus_dump_types("      < ", $param);
+	    }
+	}
+	foreach my $signal ($ins->list_signals($interface)) {
+	    push @data, "    Signal: ", $signal, "\n";
+	    foreach my $param ($ins->get_signal_params($interface, $signal)) {
+		push @data, &_dbus_dump_types("      > ", $param);
+	    }
+	}
+    }
+    return @data;
+}
+
+sub _dbus_dump_types {
+    my $indent = shift;
+    my $type = shift;
+    
+    my @data;
+    if (ref($type)) {
+	push @data, $indent, $type->[0], "\n";
+	for (my $i = 1 ; $i <= $#{$type} ; $i++) {
+	    push @data, &_dbus_dump_types($indent . "  ", $type->[$i]);
+	}
+    } else {
+	push @data, $indent, $type, "\n";
+    }
+    return @data;
+}
+
+
+sub _dbus_dump_service {
+    my $service = shift;
+    
+    my @data;
+    push @data, "Service: ", $service->get_service_name, "\n";
+    
+    my @objects = &_dbus_dump_children($service, "/");
+    foreach (@objects) {
+	push @data, "  Object: $_\n";
+    }
+    return @data;
+}
+
+sub _dbus_dump_children {
+    my $service = shift;
+    my $path = shift;
+
+    my $exp = $service->get_object($path);
+    my @exports = eval {
+	my $ins = $exp->_introspector;
+        if ($ins) {
+	    return $ins->list_children;
+        }
+	return ();
+    };
+    my @objects = map { $path eq "/" ? $path . $_ : $path . "/" . $_ } @exports;
+    if ($@) {
+	#push @objects, " Could not lookup objects under path '$path'\n";
+    }
+    foreach my $child (@exports) {
+	push @objects, _dbus_dump_children ($service, $path eq "/" ? $path . $child : $path . "/" . $child);
+    }
+    return @objects;
+}
+
+sub _dbus_dump_bus {
+    my $bus = shift;
+    
+    my @data;
+    push @data, "Bus: \n";
+    
+    
+    my $dbus = $bus->get_service("org.freedesktop.DBus");
+    my $obj = $dbus->get_object("/org/freedesktop/DBus");
+    my $names = $obj->ListNames();
+    
+    foreach (sort { $a cmp $b } @{$names}) {
+	push @data, "  Service: ", $_, "\n";
+    }
+    return @data;
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 BUGS
+
+It should print out a list of object paths registered against a
+service, but this only currently works for service implemented
+in Perl
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::RemoteService>, L<Net::DBus::Service>, 
+L<Net::DBus::RemoteObject>, L<Net::DBus::Object>, L<Data::Dumper>.
+
+=head1 COPYRIGHT
+
+Copyright 2005 Daniel Berrange <dan@berrange.com>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Error.pm b/Net-DBus/lib/Net/DBus/Error.pm
new file mode 100644
index 0000000..eda7626
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Error.pm
@@ -0,0 +1,170 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Error - Error details for remote method invocation
+
+=head1 SYNOPSIS
+
+  package Music::Player::UnknownFormat;
+
+  use base qw(Net::DBus::Error);
+
+  # Define an error type for unknown track encoding type
+  # for a music player service
+  sub new {
+      my $proto = shift;
+      my $class = ref($proto) || $proto;
+      my $self = $class->SUPER::new(name => "org.example.music.UnknownFormat",
+                                    message => "Unknown track encoding format");
+  }
+
+
+  package Music::Player::Engine;
+
+  ...snip...
+
+  # Play either mp3 or ogg music tracks, otherwise
+  # thrown an error
+  sub play {
+      my $self = shift;
+      my $url = shift;
+
+      if ($url =~ /\.(mp3|ogg)$/) {
+	  ...play the track
+      } else {
+         die Music::Player::UnknownFormat->new();
+      }
+  }
+
+
+=head1 DESCRIPTION
+
+This objects provides for strongly typed error handling. Normally
+a service would simply call
+
+  die "some message text"
+
+When returning the error condition to the calling DBus client, the
+message is associated with a generic error code or "org.freedesktop.DBus.Failed".
+While this suffices for many applications, occasionally it is desirable
+to be able to catch and handle specific error conditions. For such
+scenarios the service should create subclasses of the C<Net::DBus::Error>
+object providing in a custom error name. This error name is then sent back
+to the client instead of the genreic "org.freedesktop.DBus.Failed" code.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Error;
+
+use strict;
+use warnings;
+
+
+use overload ('""' => 'stringify');
+
+=item my $error = Net::DBus::Error->new(name => $error_name,
+                                        message => $description);
+
+Creates a new error object whose name is given by the C<name>
+parameter, and long descriptive text is provided by the 
+C<message> parameter. The C<name> parameter has certain
+formatting rules which must be adhered to. It must only contain
+the letters 'a'-'Z', '0'-'9', '-', '_' and '.'. There must be
+at least two components separated by a '.', For example a valid
+name is 'org.example.Music.UnknownFormat'.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $self = {};
+    my %params = @_;
+
+    $self->{name} = $params{name} ? $params{name} : die "name parameter is required";
+    $self->{message} = $params{message} ? $params{message} : die "message parameter is required";
+
+    bless $self, $class;
+
+    return $self;
+}
+
+=item $error->name
+
+Returns the DBus error name associated with the object.
+
+=cut
+
+sub name {
+    my $self = shift;
+    return $self->{name};
+}
+
+=item $error->message
+
+Returns the descriptive text/message associated with the
+error condition.
+
+=cut
+
+sub message {
+    my $self = shift;
+    return $self->{message};
+}
+
+=item $error->stringify
+
+Formats the error as a string in a manner suitable for
+printing out / logging / displaying to the user, etc.
+
+=cut
+
+sub stringify {
+    my $self = shift;
+
+    return $self->{name} . ": " . $self->{message} . ($self->{message} =~ /\n$/ ? "" : "\n");
+}
+
+
+1;
+
+=pod
+
+=back
+
+=head1 AUTHORS
+
+Daniel P. Berrange
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005-2006 Daniel P. Berrange
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::Object>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Exporter.pm b/Net-DBus/lib/Net/DBus/Exporter.pm
new file mode 100644
index 0000000..c9e1545
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Exporter.pm
@@ -0,0 +1,546 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Exporter - Export object methods and signals to the bus
+
+=head1 SYNOPSIS
+
+  # Define a new package for the object we're going
+  # to export
+  package Demo::HelloWorld;
+
+  # Specify the main interface provided by our object
+  use Net::DBus::Exporter qw(org.example.demo.Greeter);
+
+  # We're going to be a DBus object
+  use base qw(Net::DBus::Object);
+
+  # Export a 'Greeting' signal taking a stringl string parameter
+  dbus_signal("Greeting", ["string"]);
+
+  # Export 'Hello' as a method accepting a single string
+  # parameter, and returning a single string value
+  dbus_method("Hello", ["string"], ["string"]);
+
+  # Export 'Goodbye' as a method accepting a single string
+  # parameter, and returning a single string, but put it
+  # in the 'org.exaple.demo.Farewell' interface
+  dbus_method("Goodbye", ["string"], ["string"], "org.example.demo.Farewell");
+
+=head1 DESCRIPTION
+
+The C<Net::DBus::Exporter> module is used to export methods
+and signals defined in an object to the message bus. Since
+Perl is a loosely typed language it is not possible to automatically
+determine correct type information for methods to be exported.
+Thus when sub-classing L<Net::DBus::Object>, this package will
+provide the type information for methods and signals.
+
+When importing this package, an optional argument can be supplied
+to specify the default interface name to associate with methods
+and signals, for which an explicit interface is not specified.
+Thus in the common case of objects only providing a single interface,
+this removes the need to repeat the interface name against each
+method exported.
+
+=head1 SCALAR TYPES
+
+When specifying scalar data types for parameters and return values,
+the following string constants must be used to denote the data
+type. When values corresponding to these types are (un)marshalled
+they are represented as the Perl SCALAR data type (see L<perldata>).
+
+=over 4
+
+=item "string"
+
+A UTF-8 string of characters
+
+=item "int16"
+
+A 16-bit signed integer
+
+=item "uint16"
+
+A 16-bit unsigned integer
+
+=item "int32"
+
+A 32-bit signed integer
+
+=item "uint32"
+
+A 32-bit unsigned integer
+
+=item "int64"
+
+A 64-bit signed integer. NB, this type is not supported by
+many builds of Perl on 32-bit platforms, so if used, your
+data is liable to be truncated at 32-bits.
+
+=item "uint64"
+
+A 64-bit unsigned integer. NB, this type is not supported by
+many builds of Perl on 32-bit platforms, so if used, your
+data is liable to be truncated at 32-bits.
+
+=item "byte"
+
+A single 8-bit byte
+
+=item "bool"
+
+A boolean value
+
+=item "double"
+
+An IEEE double-precision floating point
+
+=back
+
+=head1 COMPOUND TYPES
+
+When specifying compound data types for parameters and return
+values, an array reference must be used, with the first element
+being the name of the compound type. 
+
+=over 4
+
+=item ["array", ARRAY-TYPE]
+
+An array of values, whose type os C<ARRAY-TYPE>. The C<ARRAY-TYPE>
+can be either a scalar type name, or a nested compound type. When
+values corresponding to the array type are (un)marshalled, they 
+are represented as the Perl ARRAY data type (see L<perldata>). If,
+for example, a method was declared to have a single parameter with
+the type, ["array", "string"], then when calling the method one
+would provide a array reference of strings:
+
+    $object->hello(["John", "Doe"])
+
+=item ["dict", KEY-TYPE, VALUE-TYPE]
+
+A dictionary of values, more commonly known as a hash table. The
+C<KEY-TYPE> is the name of the scalar data type used for the dictionary
+keys. The C<VALUE-TYPE> is the name of the scalar, or compound
+data type used for the dictionary values. When values corresponding
+to the dict type are (un)marshalled, they are represented as the
+Perl HASH data type (see L<perldata>). If, for example, a method was
+declared to have a single parameter with the type ["dict", "string", "string"],
+then when calling the method one would provide a hash reference 
+of strings,
+
+   $object->hello({forename => "John", surname => "Doe"});
+
+=item ["struct", VALUE-TYPE-1, VALUE-TYPE-2]
+
+A structure of values, best thought of as a variation on the array
+type where the elements can vary. Many languages have an explicit
+name associated with each value, but since Perl does not have a
+native representation of structures, they are represented by the
+LIST data type. If, for exaple, a method was declared to have a single
+parameter with the type ["struct", "string", "string"], corresponding
+to the C structure 
+
+    struct {
+      char *forename;
+      char *surname;
+    } name;
+
+then, when calling the method one would provide an array refernce
+with the values orded to match the structure
+
+   $object->hello(["John", "Doe"]);
+
+=back
+
+=head1 MAGIC TYPES
+
+When specifying introspection data for an exported service, there
+are a couple of so called C<magic> types. Parameters declared as
+magic types are not visible to clients, but instead their values
+are provided automatically by the server side bindings. One use of
+magic types is to get an extra parameter passed with the unique 
+name of the caller invoking the method.
+
+=over 4
+
+=item "caller"
+
+The value passed in is the unique name of the caller of the method.
+Unique names are strings automatically assigned to client connections
+by the bus daemon, for example ':1.15'
+
+=item "serial"
+
+The value passed in is an integer within the scope of a caller, which 
+increments on every method call. 
+
+=back
+
+=head1 ANNOTATIONS
+
+When exporting methods, signals & properties, in addition to the core
+data typing information, a number of metadata annotations are possible.
+These are specified by passing a hash reference with the desired keys
+as the last parameter when defining the export. The following annotations
+are currently supported
+
+=over 4
+
+=item no_return
+
+Indicate that this method does not return any value, and thus no reply
+message should be sent over the wire, likewise informing the clients
+not to expect / wait for a reply message
+
+=item deprecated
+
+Indicate that use of this method/signal/property is discouraged, and 
+it may disappear altogether in a future release. Clients will typically
+print out a warning message when a deprecated method/signal/property
+is used.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Exporter;
+
+use vars qw(@ISA @EXPORT %dbus_exports %dbus_introspectors);
+
+use Net::DBus::Binding::Introspector;
+
+use warnings;
+use strict;
+
+use Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(dbus_method dbus_signal dbus_property);
+
+
+sub import {
+    my $class = shift;
+
+    my $caller = caller;
+    if (exists $dbus_exports{$caller}) {
+	warn "$caller is already registered with Net::DBus::Exporter";
+	return;
+    }
+
+    $dbus_exports{$caller} = {
+	methods => {},
+	signals => {},
+	props => {},
+    };
+    die "usage: use Net::DBus::Exporter 'interface-name';" unless @_;
+
+    my $interface = shift;
+    die "interface name '$interface' is not valid." .
+	"Names must consist of tokens using the characters a-z, A-Z, 0-9, _, " .
+	"with at least two tokens, separated by '.'\n"
+	unless $interface =~ /^[a-zA-Z]\w*(\.[a-zA-Z]\w*)+$/;
+    $dbus_exports{$caller}->{interface} = $interface;
+
+    $class->export_to_level(1, "", @EXPORT);
+}
+
+sub _dbus_introspector {
+    my $object = shift;
+    my $class = shift;
+
+    $class = ref($object) unless $class;
+    die "no introspection data available for '" . 
+	$object->get_object_path . 
+	"' and object is not cast to any interface" unless $class;
+    
+    if (!exists $dbus_exports{$class}) {
+	# If this class has not been exported, lets look
+	# at the parent class & return its introspection
+        # data instead.
+	no strict 'refs';
+	if (defined (*{"${class}::ISA"})) {
+	    my @isa = @{"${class}::ISA"};
+	    foreach my $parent (@isa) {
+		# We don't recurse to Net::DBus::Object
+		# since we need to give sub-classes the
+		# choice of not supporting introspection
+		next if $parent eq "Net::DBus::Object";
+
+		my $ins = &_dbus_introspector($object, $parent);
+		if ($ins) {
+		    return $ins;
+		}
+	    }
+	}
+	return undef;
+    }
+
+    unless (exists $dbus_introspectors{$class}) {
+	my $is = Net::DBus::Binding::Introspector->new(object_path => $object->get_object_path);
+	
+	&_dbus_introspector_add(ref($object), $is);
+	$dbus_introspectors{$class} = $is;
+    }
+    
+    return $dbus_introspectors{$class};
+}
+
+sub _dbus_introspector_add {
+    my $class = shift;
+    my $introspector = shift;
+
+    my $exports = $dbus_exports{$class};
+    if ($exports) {
+	foreach my $method (keys %{$exports->{methods}}) {
+	    my ($params, $returns, $interface, $attributes) = @{$exports->{methods}->{$method}};
+	    $introspector->add_method($method, $params, $returns, $interface, $attributes);
+	}
+	foreach my $prop (keys %{$exports->{props}}) {
+	    my ($type, $access, $interface, $attributes) = @{$exports->{props}->{$prop}};
+	    $introspector->add_property($prop, $type, $access, $interface, $attributes);
+	}
+	foreach my $signal (keys %{$exports->{signals}}) {
+	    my ($params, $interface, $attributes) = @{$exports->{signals}->{$signal}};
+	    $introspector->add_signal($signal, $params, $interface, $attributes);
+	}
+    }
+    
+    if (defined (*{"${class}::ISA"})) {
+	no strict "refs";
+	my @isa = @{"${class}::ISA"};
+	foreach my $parent (@isa) {
+	    &_dbus_introspector_add($parent, $introspector);
+	}
+    }
+}
+
+=item dbus_method($name, $params, $returns, [\%annotations]);
+
+=item dbus_method($name, $params, $returns, $interface, [\%annotations]);
+
+Exports a method called C<$name>, having parameters whose types
+are defined by C<$params>, and returning values whose types are
+defined by C<$returns>. If the C<$interface> parameter is 
+provided, then the method is associated with that interface, otherwise
+the default interface for the calling package is used. The
+value for the C<$params> parameter should be an array reference
+with each element defining the data type of a parameter to the
+method. Likewise, the C<$returns> parameter should be an array 
+reference with each element defining the data type of a return
+value. If it not possible to export a method which accepts a
+variable number of parameters, or returns a variable number of
+values.
+
+=cut
+
+sub dbus_method {
+    my $name = shift;
+    my $params = [];
+    my $returns = [];
+    my $caller = caller;
+    my $interface = $dbus_exports{$caller}->{interface};
+    my %attributes;
+    
+    if (@_ && ref($_[0]) eq "ARRAY") {
+	$params = shift;
+    }
+    if (@_ && ref($_[0]) eq "ARRAY") {
+	$returns = shift;
+    }
+    if (@_ && !ref($_[0])) {
+	$interface = shift;
+    }
+    if (@_ && ref($_[0]) eq "HASH") {
+	%attributes = %{$_[0]};
+    }
+
+    if (!$interface) {
+	die "interface not specified & no default interface defined";
+    }
+    
+    $dbus_exports{$caller}->{methods}->{$name} = [$params, $returns, $interface, \%attributes];
+}
+
+
+=item dbus_property($name, $type, $access, [\%attributes]);
+
+=item dbus_property($name, $type, $access, $interface, [\%attributes]);
+
+Exports a property called C<$name>, whose data type is C<$type>.
+If the C<$interface> parameter is provided, then the property is 
+associated with that interface, otherwise the default interface 
+for the calling package is used. 
+
+=cut
+
+sub dbus_property {
+    my $name = shift;
+    my $type = "string";
+    my $access = "readwrite";
+    my $caller = caller;
+    my $interface = $dbus_exports{$caller}->{interface};
+    my %attributes;
+    
+    if (@_ && !ref($_[0])) {
+	$type = shift;
+    }
+    if (@_ && !ref($_[0])) {
+	$access = shift;
+    }
+    if (@_ && !ref($_[0])) {
+	$interface = shift;
+    }
+    if ($_ && ref($_[0]) eq "HASH") {
+	%attributes = %{$_[0]};
+    }
+
+    if (!$interface) {
+	die "interface not specified & no default interface defined";
+    }
+    
+    $dbus_exports{$caller}->{props}->{$name} = [$type, $access, $interface, \%attributes];
+}
+
+
+=item dbus_signal($name, $params);
+
+=item dbus_signal($name, $params, $interface);
+
+Exports a signal called C<$name>, having parameters whose types
+are defined by C<$params>, and returning values whose types are
+defined by C<$returns>. If the C<$interface> parameter is 
+provided, then the signal is associated with that interface, otherwise
+the default interface for the calling package is used. The
+value for the C<$params> parameter should be an array reference
+with each element defining the data type of a parameter to the
+signal. Signals do not have return values. It not possible to 
+export a signal which has a variable number of parameters.
+
+=cut
+
+sub dbus_signal {
+    my $name = shift;
+    my $params = [];
+    my $caller = caller;
+    my $interface = $dbus_exports{$caller}->{interface};
+    my %attributes;
+    
+    if (@_ && ref($_[0]) eq "ARRAY") {
+	$params = shift;
+    }
+    if (@_ && !ref($_[0])) {
+	$interface = shift;
+    }
+    if (@_ && ref($_[0]) eq "HASH") {
+	%attributes = %{$_[0]};
+    }
+
+    if (!$interface) {
+	die "interface not specified & no default interface defined";
+    }
+
+    $dbus_exports{$caller}->{signals}->{$name} = [$params, $interface, \%attributes];
+}
+
+1;
+
+=back
+
+=head1 EXAMPLES
+
+=over 4
+
+=item No paramters, no return values
+
+A method which simply prints "Hello World" each time its called
+
+   sub Hello {
+       my $self = shift;
+       print "Hello World\n";
+   }
+
+   dbus_method("Hello", [], []);
+
+=item One string parameter, returning an boolean value
+
+A method which accepts a process name, issues the killall
+command on it, and returns a boolean value to indicate whether
+it was successful.
+
+   sub KillAll {
+       my $self = shift;
+       my $processname = shift;
+       my $ret  = system("killall $processname");
+       return $ret == 0 ? 1 : 0;
+   }
+
+   dbus_method("KillAll", ["string"], ["bool"]);
+
+=item One list of strings parameter, returning a dictionary
+
+A method which accepts a list of files names, stats them, and
+returns a dictionary containing the last modification times.
+
+    sub LastModified {
+       my $self = shift;
+       my $files = shift;
+
+       my %mods;
+       foreach my $file (@{$files}) {
+          $mods{$file} = (stat $file)[9];
+       }
+       return \%mods;
+    }
+
+    dbus_method("LastModified", ["array", "string"], ["dict", "string", "int32"]);
+
+=item Annotating methods with metdata
+
+A method which is targetted for removal, and also does not
+return any value
+
+    sub PlayMP3 {
+	my $self = shift;
+        my $track = shift;
+
+        system "mpg123 $track &";
+    }
+
+    dbus_method("PlayMP3", ["string"], [], { deprecated => 1, no_return => 1 });
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Object>, L<Net::DBus::Binding::Introspector>
+
+=head1 AUTHORS
+
+Daniel P. Berrange <dan@berrange.com>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Makefile.am b/Net-DBus/lib/Net/DBus/Makefile.am
new file mode 100644
index 0000000..dc8932a
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Makefile.am
@@ -0,0 +1,16 @@
+SUBDIRS = Binding 
+
+EXTRA_DIST = \
+	Annotation.pm \
+	ASyncReply.pm \
+	Binding \
+	Callback.pm \
+	Dumper.pm \
+	Error.pm \
+	Exporter.pm \
+	Object.pm \
+	Reactor.pm \
+	RemoteObject.pm \
+	RemoteService.pm \
+	Service.pm
+
diff --git a/Net-DBus/lib/Net/DBus/Object.pm b/Net-DBus/lib/Net/DBus/Object.pm
new file mode 100644
index 0000000..0691aec
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Object.pm
@@ -0,0 +1,635 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Object - Provide objects to the bus for clients to use
+
+=head1 SYNOPSIS
+
+  # Connecting an object to the bus, under a service
+  package main;
+
+  use Net::DBus;
+
+  # Attach to the bus
+  my $bus = Net::DBus->find;
+
+  # Acquire a service 'org.demo.Hello'
+  my $service = $bus->export_service("org.demo.Hello");
+
+  # Export our object within the service
+  my $object = Demo::HelloWorld->new($service);
+
+  ....rest of program...
+
+  # Define a new package for the object we're going
+  # to export
+  package Demo::HelloWorld;
+
+  # Specify the main interface provided by our object
+  use Net::DBus::Exporter qw(org.example.demo.Greeter);
+
+  # We're going to be a DBus object
+  use base qw(Net::DBus::Object);
+
+  # Export a 'Greeting' signal taking a stringl string parameter
+  dbus_signal("Greeting", ["string"]);
+
+  # Export 'Hello' as a method accepting a single string
+  # parameter, and returning a single string value
+  dbus_method("Hello", ["string"], ["string"]);
+
+  sub new {
+      my $class = shift;
+      my $service = shift;
+      my $self = $class->SUPER::new($service, "/org/demo/HelloWorld");
+
+      bless $self, $class;
+
+      return $self;
+  }
+
+  sub Hello {
+    my $self = shift;
+    my $name = shift;
+
+    $self->emit_signal("Greeting", "Hello $name");
+    return "Said hello to $name";
+  }
+
+  # Export 'Goodbye' as a method accepting a single string
+  # parameter, and returning a single string, but put it
+  # in the 'org.exaple.demo.Farewell' interface
+
+  dbus_method("Goodbye", ["string"], ["string"], "org.example.demo.Farewell");
+
+  sub Goodbye {
+    my $self = shift;
+    my $name = shift;
+
+    $self->emit_signal("Greeting", "Goodbye $name");
+    return "Said goodbye to $name";
+  }
+
+=head1 DESCRIPTION
+
+This the base of all objects which are exported to the
+message bus. It provides the core support for type introspection
+required for objects exported to the message. When sub-classing
+this object, methods can be created & tested as per normal Perl
+modules. Then just as the L<Exporter> module is used to export
+methods within a script, the L<Net::DBus::Exporter> module is
+used to export methods (and signals) to the message bus.
+
+All packages inheriting from this, will automatically have the
+interface C<org.freedesktop.DBus.Introspectable> registered
+with L<Net::DBus::Exporter>, and the C<Introspect> method within
+this exported.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Object;
+
+use 5.006;
+use strict;
+use warnings;
+
+our $ENABLE_INTROSPECT;
+
+BEGIN {
+    if ($ENV{DBUS_DISABLE_INTROSPECT}) {
+	$ENABLE_INTROSPECT = 0;
+    } else {
+	$ENABLE_INTROSPECT = 1;
+    }
+}
+
+use Net::DBus::Exporter "org.freedesktop.DBus.Introspectable";
+
+dbus_method("Introspect", [], ["string"]);
+
+dbus_method("Get", ["string", "string"], [["variant"]], "org.freedesktop.DBus.Properties");
+dbus_method("Set", ["string", "string", ["variant"]], [], "org.freedesktop.DBus.Properties");
+
+=item my $object = Net::DBus::Object->new($service, $path)
+
+This creates a new DBus object with an path of C<$path>
+registered within the service C<$service>. The C<$path>
+parameter should be a string complying with the usual
+DBus requirements for object paths, while the C<$service>
+parameter should be an instance of L<Net::DBus::Service>.
+The latter is typically obtained by calling the C<export_service>
+method on the L<Net::DBus> object.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $self = {};
+
+    my $parent = shift;
+    my $path = shift;
+
+    $self->{parent} = $parent;
+    if ($parent->isa(__PACKAGE__)) {
+	$self->{service} = $parent->get_service;
+	$self->{object_path} = $parent->get_object_path . $path;
+    } else {
+	$self->{service} = $parent;
+	$self->{object_path} = $path;
+    }
+
+    $self->{interface} = shift;
+    $self->{introspector} = undef;
+    $self->{introspected} = 0;
+    $self->{callbacks} = {};
+    $self->{children} = {};
+
+    bless $self, $class;
+
+    if ($self->{parent}->isa(__PACKAGE__)) {
+	$self->{parent}->_register_child($self);
+    } else {
+	$self->get_service->_register_object($self);
+    }
+
+    return $self;
+}
+
+
+=item $object->disconnect();
+
+This method disconnects the object from the bus, such that it
+will no longer receive messages sent by other clients. Any
+child objects will be recursively disconnected too. After an
+object has been disconnected, it is possible for Perl to
+garbage collect the object instance. It will also make it
+possible to connect a newly created object to the same path.
+
+=cut
+
+sub disconnect {
+    my $self = shift;
+
+    return unless $self->{parent};
+
+    foreach my $child (keys %{$self->{children}}) {
+	$self->_unregister_child($self->{children}->{$child});
+    }
+
+    if ($self->{parent}->isa(__PACKAGE__)) {
+	$self->{parent}->_unregister_child($self);
+    } else {
+	$self->get_service->_unregister_object($self);
+    }
+    $self->{parent} = undef;
+}
+
+=item my $bool = $object->is_connected
+
+Returns a true value if the object is connected to the bus,
+and thus capable of being accessed by remote clients. Returns
+false if the object is disconnected & thus ready for garbage
+collection. All objects start off in the connected state, and
+will only transition if the C<disconnect> method is called.
+
+=cut
+
+sub is_connected {
+    my $self = shift;
+
+    return 0 unless $self->{parent};
+
+    if ($self->{parent}->isa(__PACKAGE__)) {
+	return $self->{parent}->is_connected;
+    }
+    return 1;
+}
+
+sub DESTROY {
+    my $self = shift;
+    # XXX there are some issues during global
+    # destruction which need to be better figured
+    # out before this will work
+    #$self->disconnect;
+}
+
+sub _register_child {
+    my $self = shift;
+    my $object = shift;
+
+    $self->get_service->_register_object($object);
+    $self->{children}->{$object->get_object_path} = $object;
+}
+
+
+sub _unregister_child {
+    my $self = shift;
+    my $object = shift;
+
+    $self->get_service->_unregister_object($object);
+    delete $self->{children}->{$object->get_object_path};
+}
+
+=item my $service = $object->get_service
+
+Retrieves the L<Net::DBus::Service> object within which this
+object is exported.
+
+=cut
+
+sub get_service {
+    my $self = shift;
+    return $self->{service};
+}
+
+
+=item my $path = $object->get_object_path
+
+Retrieves the path under which this object is exported
+
+=cut
+
+sub get_object_path {
+    my $self = shift;
+    return $self->{object_path};
+}
+
+=item $object->emit_signal_in($name, $interface, $client, @args);
+
+Emits a signal from the object, with a name of C<$name>. If the
+C<$interface> parameter is defined, the signal will be scoped
+within that interface. If the C<$client> parameter is defined,
+the signal will be unicast to that client on the bus. The
+signal and the data types of the arguments C<@args> must have
+been registered with L<Net::DBus::Exporter> by calling the
+C<dbus_signal> method.
+
+=cut
+
+sub emit_signal_in {
+    my $self = shift;
+    my $name = shift;
+    my $interface = shift;
+    my $destination = shift;
+    my @args = @_;
+
+    die "object is disconnected from the bus" unless $self->is_connected;
+
+    my $con = $self->get_service->get_bus->get_connection;
+
+    my $signal = $con->make_signal_message($self->get_object_path,
+					   $interface,
+					   $name);
+    if ($destination) {
+	$signal->set_destination($destination);
+    }
+
+    my $ins = $self->_introspector;
+    if ($ins) {
+	$ins->encode($signal, "signals", $name, "params", @args);
+    } else {
+	$signal->append_args_list(@args);
+    }
+    $con->send($signal);
+
+    # Short circuit locally registered callbacks
+    if (exists $self->{callbacks}->{$interface} &&
+	exists $self->{callbacks}->{$interface}->{$name}) {
+	my $cb = $self->{callbacks}->{$interface}->{$name};
+	&$cb(@args);
+    }
+}
+
+=item $self->emit_signal_to($name, $client, @args);
+
+Emits a signal from the object, with a name of C<$name>. The
+signal and the data types of the arguments C<@args> must have
+been registered with L<Net::DBus::Exporter> by calling the
+C<dbus_signal> method. The signal will be sent only to the
+client named by the C<$client> parameter.
+
+=cut
+
+sub emit_signal_to {
+    my $self = shift;
+    my $name = shift;
+    my $destination = shift;
+    my @args = @_;
+
+    my $intro = $self->_introspector;
+    if (!$intro) {
+	die "no introspection data available for '" . $self->get_object_path .
+	    "', use the emit_signal_in method instead";
+    }
+    my @interfaces = $intro->has_signal($name);
+    if ($#interfaces == -1) {
+	die "no signal with name '$name' is exported in object '" .
+	    $self->get_object_path . "'\n";
+    } elsif ($#interfaces > 0) {
+	die "signal '$name' is exported in more than one interface of '" .
+	    $self->get_object_path . "', use the emit_signal_in method instead.";
+    }
+    $self->emit_signal_in($name, $interfaces[0], $destination, @args);
+}
+
+=item $self->emit_signal($name, @args);
+
+Emits a signal from the object, with a name of C<$name>. The
+signal and the data types of the arguments C<@args> must have
+been registered with L<Net::DBus::Exporter> by calling the
+C<dbus_signal> method. The signal will be broadcast to all
+clients on the bus.
+
+=cut
+
+sub emit_signal {
+    my $self = shift;
+    my $name = shift;
+    my @args = @_;
+
+    $self->emit_signal_to($name, undef, @args);
+}
+
+=item $object->connect_to_signal_in($name, $interface, $coderef);
+
+Connects a callback to a signal emitted by the object. The C<$name>
+parameter is the name of the signal within the object, and C<$coderef>
+is a reference to an anonymous subroutine. When the signal C<$name>
+is emitted by the remote object, the subroutine C<$coderef> will be
+invoked, and passed the parameters from the signal. The C<$interface>
+parameter is used to specify the explicit interface defining the
+signal to connect to.
+
+=cut
+
+sub connect_to_signal_in {
+    my $self = shift;
+    my $name = shift;
+    my $interface = shift;
+    my $code = shift;
+
+    die "object is disconnected from the bus" unless $self->is_connected;
+
+    $self->{callbacks}->{$interface} = {} unless
+	exists $self->{callbacks}->{$interface};
+    $self->{callbacks}->{$interface}->{$name} = $code;
+}
+
+=item $object->connect_to_signal($name, $coderef);
+
+Connects a callback to a signal emitted by the object. The C<$name>
+parameter is the name of the signal within the object, and C<$coderef>
+is a reference to an anonymous subroutine. When the signal C<$name>
+is emitted by the remote object, the subroutine C<$coderef> will be
+invoked, and passed the parameters from the signal.
+
+=cut
+
+sub connect_to_signal {
+    my $self = shift;
+    my $name = shift;
+    my $code = shift;
+
+    my $ins = $self->_introspector;
+    if (!$ins) {
+	die "no introspection data available for '" . $self->get_object_path .
+	    "', use the connect_to_signal_in method instead";
+    }
+    my @interfaces = $ins->has_signal($name);
+
+    if ($#interfaces == -1) {
+	die "no signal with name '$name' is exported in object '" .
+	    $self->get_object_path . "'\n";
+    } elsif ($#interfaces > 0) {
+	die "signal with name '$name' is exported " .
+	    "in multiple interfaces of '" . $self->get_object_path . "'" .
+	    "use the connect_to_signal_in method instead";
+    }
+
+    $self->connect_to_signal_in($name, $interfaces[0], $code);
+}
+
+
+sub _dispatch {
+    my $self = shift;
+    my $connection = shift;
+    my $message = shift;
+
+    # Experiment in handling dispatch for child objects internally
+#     my $path = $message->get_path;
+#     while ($path ne $self->get_object_path) {
+#	if (exists $self->{children}->{$path}) {
+#	    $self->{children}->{$path}->_dispatch($connection, $message);
+#	    return;
+#	}
+#	$path =~ s,/[^/]+$,,;
+#     }
+
+    my $reply;
+    my $method_name = $message->get_member;
+    my $interface = $message->get_interface;
+    if ($interface eq "org.freedesktop.DBus.Introspectable") {
+	if ($method_name eq "Introspect" &&
+	    $self->_introspector &&
+	    $ENABLE_INTROSPECT) {
+	    my $xml = $self->_introspector->format;
+	    $reply = $connection->make_method_return_message($message);
+
+	    $self->_introspector->encode($reply, "methods", $method_name, "returns", $xml);
+	}
+    } elsif ($interface eq "org.freedesktop.DBus.Properties") {
+	if ($method_name eq "Get") {
+	    $reply = $self->_dispatch_prop_read($connection, $message);
+	} elsif ($method_name eq "Set") {
+	    $reply = $self->_dispatch_prop_write($connection, $message);
+	}
+    } elsif ($self->can($method_name)) {
+	my $ins = $self->_introspector;
+	my @ret = eval {
+	    my @args;
+	    if ($ins) {
+		@args = $ins->decode($message, "methods", $method_name, "params");
+	    } else {
+		@args = $message->get_args_list;
+	    }
+
+	    $self->$method_name(@args);
+	};
+	if ($@) {
+	    my $name = UNIVERSAL::isa($@, "Net::DBus::Error") ? $@->name : "org.freedesktop.DBus.Error.Failed";
+	    my $desc = UNIVERSAL::isa($@, "Net::DBus::Error") ? $@->message : $@;
+	    $reply = $connection->make_error_message($message,
+					      $name,
+					      $desc);
+	} else {
+	    $reply = $connection->make_method_return_message($message);
+	    if ($ins) {
+		$self->_introspector->encode($reply, "methods", $method_name, "returns", @ret);
+	    } else {
+		$reply->append_args_list(@ret);
+	    }
+	}
+    }
+
+    if (!$reply) {
+	$reply = $connection->make_error_message($message,
+						 "org.freedesktop.DBus.Error.Failed",
+						 "No such method " . ref($self) . "->" . $method_name);
+    }
+
+    if ($message->get_no_reply()) {
+	# Not sending reply
+    } else {
+	$self->get_service->get_bus->get_connection->send($reply);
+    }
+}
+
+
+sub _dispatch_prop_read {
+    my $self = shift;
+    my $connection = shift;
+    my $message = shift;
+
+    my $ins = $self->_introspector;
+
+    if (!$ins) {
+	return $connection->make_error_message($message,
+					       "org.freedesktop.DBus.Error.Failed",
+					       "no introspection data exported for properties");
+    }
+
+    my ($pinterface, $pname) = $ins->decode($message, "methods", "Get", "params");
+
+    if (!$ins->has_property($pname, $pinterface)) {
+	return $connection->make_error_message($message,
+					       "org.freedesktop.DBus.Error.Failed",
+					       "no property '$pname' exported in interface '$pinterface'");
+    }
+
+    if (!$ins->is_property_readable($pinterface, $pname)) {
+	return $connection->make_error_message($message,
+					       "org.freedesktop.DBus.Error.Failed",
+					       "property '$pname' in interface '$pinterface' is not readable");
+    }
+
+    if ($self->can($pname)) {
+	my $value = eval {
+	    $self->$pname;
+	};
+	if ($@) {
+	    return $connection->make_error_message($message,
+						   "org.freedesktop.DBus.Error.Failed",
+						   "error reading '$pname' in interface '$pinterface': $@");
+	} else {
+	    my $reply = $connection->make_method_return_message($message);
+
+	    $self->_introspector->encode($reply, "methods", "Get", "returns", $value);
+	    return $reply;
+	}
+    } else {
+	return $connection->make_error_message($message,
+					       "org.freedesktop.DBus.Error.Failed",
+					       "no method to read property '$pname' in interface '$pinterface'");
+    }
+}
+
+sub _dispatch_prop_write {
+    my $self = shift;
+    my $connection = shift;
+    my $message = shift;
+
+    my $ins = $self->_introspector;
+
+    if (!$ins) {
+	return $connection->make_error_message($message,
+					       "org.freedesktop.DBus.Error.Failed",
+					       "no introspection data exported for properties");
+    }
+
+    my ($pinterface, $pname, $pvalue) = $ins->decode($message, "methods", "Set", "params");
+
+    if (!$ins->has_property($pname, $pinterface)) {
+	return $connection->make_error_message($message,
+					       "org.freedesktop.DBus.Error.Failed",
+					       "no property '$pname' exported in interface '$pinterface'");
+    }
+
+    if (!$ins->is_property_writable($pinterface, $pname)) {
+	return $connection->make_error_message($message,
+					       "org.freedesktop.DBus.Error.Failed",
+					       "property '$pname' in interface '$pinterface' is not writable");
+    }
+
+    if ($self->can($pname)) {
+	eval {
+	    $self->$pname($pvalue);
+	};
+	if ($@) {
+	    return $connection->make_error_message($message,
+						   "org.freedesktop.DBus.Error.Failed",
+						   "error writing '$pname' in interface '$pinterface': $@");
+	} else {
+	    return $connection->make_method_return_message($message);
+	}
+    } else {
+	return $connection->make_error_message($message,
+					       "org.freedesktop.DBus.Error.Failed",
+					       "no method to write property '$pname' in interface '$pinterface'");
+    }
+}
+
+
+sub _introspector {
+    my $self = shift;
+
+    if (!$self->{introspected}) {
+	$self->{introspector} = Net::DBus::Exporter::_dbus_introspector($self);
+	$self->{introspected} = 1;
+    }
+    return $self->{introspector};
+}
+
+1;
+
+
+=pod
+
+=back
+
+=head1 AUTHORS
+
+Daniel P. Berrange
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005-2006 Daniel P. Berrange
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::Service>, L<Net::DBus::RemoteObject>,
+L<Net::DBus::Exporter>.
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Reactor.pm b/Net-DBus/lib/Net/DBus/Reactor.pm
new file mode 100644
index 0000000..99b9f03
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Reactor.pm
@@ -0,0 +1,778 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Reactor - application event loop 
+
+=head1 SYNOPSIS
+
+Create and run an event loop:
+
+   use Net::DBus::Reactor;
+   my $reactor = Net::DBus::Reactor->new();
+
+   $reactor->run();
+
+Manage some file handlers
+
+   $reactor->add_read($fd, 
+                      Net::DBus::Callback->new(method => sub {
+                         my $fd = shift;
+                         ...read some data...
+                      }, args => [$fd]);
+
+   $reactor->add_write($fd, 
+                      Net::DBus::Callback->new(method => sub {
+                         my $fd = shift;
+                         ...write some data...
+                      }, args => [$fd]);
+
+Temporarily (dis|en)able a handle
+
+   # Disable
+   $reactor->toggle_read($fd, 0);
+   # Enable
+   $reactor->toggle_read($fd, 1);
+
+Permanently remove a handle
+
+   $reactor->remove_read($fd);
+
+Manage a regular timeout every 100 milliseconds
+
+   my $timer = $reactor->add_timeout(100,
+                                     Net::DBus::Callback->new(
+              method => sub {
+                 ...process the alarm...
+              }));
+
+Temporarily (dis|en)able a timer
+
+   # Disable
+   $reactor->toggle_timeout($timer, 0);
+   # Enable
+   $reactor->toggle_timeout($timer, 1);
+
+Permanently remove a timer
+
+   $reactor->remove_timeout($timer);
+
+Add a post-dispatch hook
+
+   my $hook = $reactor->add_hook(Net::DBus::Callback->new(
+         method => sub {
+            ... do some work...
+         }));
+
+Remove a hook
+
+   $reactor->remove_hook($hook);
+
+=head1 DESCRIPTION
+
+This class provides a general purpose event loop for
+the purposes of multiplexing I/O events and timeouts
+in a single process. The underlying implementation is
+done using the select system call. File handles can
+be registered for monitoring on read, write and exception
+(out-of-band data) events. Timers can be registered
+to expire with a periodic frequency. These are implemented
+using the timeout parameter of the select system call.
+Since this parameter merely represents an upper bound
+on the amount of time the select system call is allowed
+to sleep, the actual period of the timers may vary. Under
+normal load this variance is typically 10 milliseconds.
+Finally, hooks may be registered which will be invoked on
+each iteration of the event loop (ie after processing
+the file events, or timeouts indicated by the select
+system call returning).
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Reactor;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus::Binding::Watch;
+use Net::DBus::Callback;
+use Time::HiRes qw(gettimeofday);
+
+=item my $reactor = Net::DBus::Reactor->new();
+
+Creates a new event loop ready for monitoring file handles, or 
+generating timeouts. Except in very unsual circumstances (examples
+of which I can't think up) it is not neccessary or desriable to
+explicitly create new reactor instances. Instead call the L<main>
+method to get a handle to the singleton instance.
+
+=cut
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my %params = @_;
+    my $self = {};
+
+    $self->{fds} = {
+	read => {},
+	write => {},
+	exception => {}
+    };
+    $self->{timeouts} = [];
+    $self->{hooks} = [];
+
+    bless $self, $class;
+
+    return $self;
+}
+
+use vars qw($main_reactor);
+
+=item $reactor->main
+
+Return a handle to the singleton instance of the reactor. This
+is the recommended way of getting hold of a reactor, since it
+removes the need for modules to pass around handles to their
+privately created reactors.
+
+=cut
+
+sub main {
+    my $class = shift;
+    $main_reactor = $class->new() unless defined $main_reactor;
+    return $main_reactor;
+}
+
+
+=item $reactor->manage($connection);
+
+=item $reactor->manage($server);
+
+Registers a C<Net::DBus::Connection> or C<Net::DBus::Server> object
+for management by the event loop. This basically involves
+hooking up the watch & timeout callbacks to the event loop.
+For connections it will also register a hook to invoke the
+C<dispatch> method periodically.
+
+=cut
+
+sub manage {
+    my $self = shift;
+    my $object = shift;
+
+    if ($object->can("set_watch_callbacks")) {
+	$object->set_watch_callbacks(sub {
+	    my $object = shift;
+	    my $watch = shift;
+
+	    $self->_manage_watch_on($object, $watch);
+	}, sub {
+	    my $object = shift;
+	    my $watch = shift;
+
+	    $self->_manage_watch_off($object, $watch);
+	}, sub {
+	    my $object = shift;
+	    my $watch = shift;
+
+	    $self->_manage_watch_toggle($object, $watch);
+	});
+    }
+    
+    if ($object->can("set_timeout_callbacks")) {
+	$object->set_timeout_callbacks(sub {
+	    my $object = shift;
+	    my $timeout = shift;
+	    
+	    my $key = $self->add_timeout($timeout->get_interval,
+					 Net::DBus::Callback->new(object => $timeout,
+								  method => "handle",
+								  args => []),
+					 $timeout->is_enabled);
+	    $timeout->set_data($key);
+	}, sub {
+	    my $object = shift;
+	    my $timeout = shift;
+	    
+	    my $key = $timeout->get_data;
+	    $self->remove_timeout($key);
+	}, sub {
+	    my $object = shift;
+	    my $timeout = shift;
+	    
+	    my $key = $timeout->get_data;
+	    $self->remove_timeout($key,
+				  $timeout->is_enabled,
+				  $timeout->get_interval);
+	});
+    }
+    
+    if ($object->can("dispatch")) {
+	$self->add_hook(Net::DBus::Callback->new(object => $object, 
+						 method => "dispatch", 
+						 args => []), 
+			1);
+    }
+    if ($object->can("flush")) {
+	$self->add_hook(Net::DBus::Callback->new(object => $object, 
+						 method => "flush", 
+						 args => []), 
+			1);
+    }
+}
+
+
+sub _manage_watch_on {
+    my $self = shift;
+    my $object = shift;
+    my $watch = shift;
+    my $flags = $watch->get_flags;
+
+    if ($flags & &Net::DBus::Binding::Watch::READABLE) {
+	$self->add_read($watch->get_fileno, 
+			Net::DBus::Callback->new(object => $watch, 
+					    method => "handle", 
+					    args => [&Net::DBus::Binding::Watch::READABLE]), 
+			$watch->is_enabled);
+    }
+    if ($flags & &Net::DBus::Binding::Watch::WRITABLE) {
+	$self->add_write($watch->get_fileno, 
+			 Net::DBus::Callback->new(object => $watch, 
+					     method => "handle", 
+					     args => [&Net::DBus::Binding::Watch::WRITABLE]), 
+			 $watch->is_enabled);
+    }
+#    $self->add_exception($watch->get_fileno, $watch, 
+#			 Net::DBus::Callback->new(object => $watch, 
+#					     method => "handle", 
+#					     args => [&Net::DBus::Binding::Watch::ERROR]), 
+#			 $watch->is_enabled);
+    
+}
+
+sub _manage_watch_off {
+    my $self = shift;
+    my $object = shift;
+    my $watch = shift;
+    my $flags = $watch->get_flags;
+    
+    if ($flags & &Net::DBus::Binding::Watch::READABLE) {
+	$self->remove_read($watch->get_fileno);
+    }
+    if ($flags & &Net::DBus::Binding::Watch::WRITABLE) {
+	$self->remove_write($watch->get_fileno);
+    }
+#    $self->remove_exception($watch->get_fileno);
+}
+
+sub _manage_watch_toggle {
+    my $self = shift;
+    my $object = shift;
+    my $watch = shift;
+    my $flags = $watch->get_flags;
+    
+    if ($flags & &Net::DBus::Binding::Watch::READABLE) {
+	$self->toggle_read($watch->get_fileno, $watch->is_enabled);
+    }
+    if ($flags & &Net::DBus::Binding::Watch::WRITABLE) {
+	$self->toggle_write($watch->get_fileno, $watch->is_enabled);
+    }
+    $self->toggle_exception($watch->get_fileno, $watch->is_enabled);
+}
+
+
+=item $reactor->run();
+
+Starts the event loop monitoring any registered
+file handles and timeouts. At least one file
+handle, or timer must have been registered prior
+to running the reactor, otherwise it will immediately
+exit. The reactor will run until all registered
+file handles, or timeouts have been removed, or
+disabled. The reactor can be explicitly stopped by
+calling the C<shutdown> method.
+
+=cut
+
+sub run {
+    my $self = shift;
+
+    $self->{running} = 1;
+    while ($self->{running}) { $self->step };
+}
+
+=item $reactor->shutdown();
+
+Explicitly shutdown the reactor after pending
+events have been processed.
+
+=cut
+
+sub shutdown {
+    my $self = shift;
+    $self->{running} = 0;
+}
+
+=item $reactor->step();
+
+Perform one iteration of the event loop, going to
+sleep until an event occurs on a registered file
+handle, or a timeout occurrs. This method is generally
+not required in day-to-day use.
+
+=cut
+
+sub step {
+    my $self = shift;
+   
+    my @callbacks = $self->_dispatch_hook();
+    
+    foreach my $callback (@callbacks) {
+	$callback->invoke;
+    }
+
+    my ($ri, $ric) = $self->_bits("read");
+    my ($wi, $wic) = $self->_bits("write");
+    my ($ei, $eic) = $self->_bits("exception");
+    my $timeout = $self->_timeout($self->_now);
+    
+    if (!$ric && !$wic && !$eic && !(defined $timeout)) {
+	$self->{running} = 0;
+	return;
+    }
+        
+    my ($ro, $wo, $eo);
+    my $n = select($ro=$ri,$wo=$wi,$eo=$ei, (defined $timeout ? ($timeout ? $timeout/1000 : 0) : undef));
+    
+    @callbacks = ();
+    if ($n) {
+	push @callbacks, $self->_dispatch_fd("read", $ro);
+	push @callbacks, $self->_dispatch_fd("write", $wo);
+	push @callbacks, $self->_dispatch_fd("error", $eo);
+    }
+    push @callbacks, $self->_dispatch_timeout($self->_now);
+    #push @callbacks, $self->_dispatch_hook();
+    
+    foreach my $callback (@callbacks) {
+	$callback->invoke;
+    }
+
+    return 1;
+}
+
+sub _now {
+    my $self = shift;
+    
+    my @now = gettimeofday;
+    
+    return $now[0] * 1000 + (($now[1] - ($now[1] % 1000)) / 1000);
+}
+
+sub _bits {
+    my $self = shift;
+    my $type = shift;
+    my $vec = '';
+
+    my $count = 0;
+    foreach (keys %{$self->{fds}->{$type}}) {
+	next unless $self->{fds}->{$type}->{$_}->{enabled};
+
+	$count++;
+	vec($vec, $_, 1) = 1;
+    }
+    return ($vec, $count);
+}
+
+sub _timeout {
+    my $self = shift;
+    my $now = shift;
+    
+    my $timeout;
+    foreach (@{$self->{timeouts}}) {
+	next unless $_->{enabled};
+
+	my $expired = $now - $_->{last_fired};
+	my $interval = ($expired > $_->{interval} ? 0 : $_->{interval} - $expired);
+	$timeout = $interval if !(defined $timeout) ||
+	    ($interval < $timeout);
+    }
+    return $timeout;
+}
+
+
+sub _dispatch_fd {
+    my $self = shift;
+    my $type = shift;
+    my $vec = shift;
+    
+    my @callbacks;
+    foreach my $fd (keys %{$self->{fds}->{$type}}) {
+	next unless $self->{fds}->{$type}->{$fd}->{enabled};
+
+	if (vec($vec, $fd, 1)) {
+	    my $rec = $self->{fds}->{$type}->{$fd};
+	    
+	    push @callbacks, $self->{fds}->{$type}->{$fd}->{callback};
+	}
+    }
+    return @callbacks;
+}
+
+
+sub _dispatch_timeout {
+    my $self = shift;
+    my $now = shift;
+    
+    my @callbacks;
+    foreach my $timeout (@{$self->{timeouts}}) {
+	next unless $timeout->{enabled};
+	my $expired = $now - $timeout->{last_fired};
+
+	# Select typically returns a little (0-10 ms) before we 
+	# asked it for. (8 milliseconds seems reasonable balance
+	# between early timeouts & extra select calls
+	if ($expired >= ($timeout->{interval}-8)) {
+	    $timeout->{last_fired} = $now;
+	    push @callbacks, $timeout->{callback};
+	}
+    }
+    return @callbacks;
+}
+
+
+sub _dispatch_hook {
+    my $self = shift;
+    my $now = shift;
+
+    my @callbacks;
+    foreach my $hook (@{$self->{hooks}}) {
+	next unless $hook->{enabled};
+	push @callbacks, $hook->{callback};
+    }
+    return @callbacks;
+}
+
+
+=item $reactor->add_read($fd, $callback[, $status]);
+
+Registers a file handle for monitoring of read
+events. The C<$callback> parameter specifies an
+instance of the C<Net::DBus::Callback> object to invoke
+each time an event occurs. The optional C<$status>
+parameter is a boolean value to specify whether the
+watch is initially enabled.
+
+=cut
+
+sub add_read {
+    my $self = shift;
+    $self->_add("read", @_);
+}
+
+=item $reactor->add_write($fd, $callback[, $status]);
+
+Registers a file handle for monitoring of write
+events. The C<$callback> parameter specifies an
+instance of the C<Net::DBus::Callback> object to invoke
+each time an event occurs. The optional C<$status>
+parameter is a boolean value to specify whether the
+watch is initially enabled.
+
+=cut
+
+sub add_write {
+    my $self = shift;
+    $self->_add("write", @_);
+}
+
+
+=item $reactor->add_exception($fd, $callback[, $status]);
+
+Registers a file handle for monitoring of exception
+events. The C<$callback> parameter specifies an
+instance of the C<Net::DBus::Callback> object to invoke
+each time an event occurs. The optional C<$status>
+parameter is a boolean value to specify whether the
+watch is initially enabled.
+
+=cut
+
+sub add_exception {
+    my $self = shift;
+    $self->_add("exception", @_);
+}
+
+
+=item my $id = $reactor->add_timeout($interval, $callback, $status);
+
+Registers a new timeout to expire every C<$interval>
+milliseconds. The C<$callback> parameter specifies an
+instance of the C<Net::DBus::Callback> object to invoke
+each time the timeout expires. The optional C<$status>
+parameter is a boolean value to specify whether the
+timeout is initially enabled. The return parameter is
+a unique identifier which can be used to later remove
+or disable the timeout.
+
+=cut
+
+sub add_timeout {
+    my $self = shift;
+    my $interval = shift;
+    my $callback = shift;
+    my $enabled = shift;    
+    $enabled = 1 unless defined $enabled;
+
+    my $key;
+    for (my $i = 0 ; $i <= $#{$self->{timeouts}} && !(defined $key); $i++) {
+	$key = $i unless defined $self->{timeouts}->[$i];
+    }
+    $key = $#{$self->{timeouts}}+1 unless defined $key;
+    
+    $self->{timeouts}->[$key] = {
+	interval => $interval,
+	last_fired => $self->_now,
+	callback => $callback,
+	enabled => $enabled
+	};
+
+    return $key;
+}
+
+
+=item $reactor->remove_timeout($id);
+
+Removes a previously registered timeout specified by
+the C<$id> parameter.
+
+=cut
+
+sub remove_timeout {
+    my $self = shift;
+    my $key = shift;
+    
+    die "no timeout active with key '$key'" 
+	unless defined $self->{timeouts}->[$key];
+
+    $self->{timeouts}->[$key] = undef;
+}
+
+
+=item $reactor->toggle_timeout($id, $status[, $interval]);
+
+Updates the state of a previously registered timeout
+specifed by the C<$id> parameter. The C<$status>
+parameter specifies whether the timeout is to be enabled
+or disabled, while the optional C<$interval> parameter
+can be used to change the period of the timeout.
+
+=cut
+
+sub toggle_timeout {
+    my $self = shift;
+    my $key = shift;
+    my $enabled = shift;
+    
+    $self->{timeouts}->[$key]->{enabled} = $enabled;
+    $self->{timeouts}->[$key]->{interval} = shift if @_;
+}
+
+
+=item my $id = $reactor->add_hook($callback[, $status]);
+
+Registers a new hook to be fired on each iteration
+of the event loop. The C<$callback> parameter
+specifies an instance of the C<Net::DBus::Callback>
+class to invoke. The C<$status> parameter determines
+whether the hook is initially enabled, or disabled.
+The return parameter is a unique id which should
+be used to later remove, or disable the hook.
+
+=cut
+
+sub add_hook {
+    my $self = shift;
+    my $callback = shift;
+    my $enabled = shift;    
+    $enabled = 1 unless defined $enabled;
+    
+    my $key;
+    for (my $i = 0 ; $i <= $#{$self->{hooks}} && !(defined $key); $i++) {
+	$key = $i unless defined $self->{hooks}->[$i];
+    }
+    $key = $#{$self->{hooks}}+1 unless defined $key;
+
+    $self->{hooks}->[$key] = {
+	callback => $callback,
+	enabled => $enabled
+	};
+
+    return $key;
+}
+
+
+=item $reactor->remove_hook($id)
+
+Removes the previously registered hook identified
+by C<$id>.
+
+=cut
+
+sub remove_hook {
+    my $self = shift;
+    my $key = shift;
+    
+    die "no hook present with key '$key'" 
+	unless defined $self->{hooks}->[$key];
+
+
+    $self->{hooks}->[$key] = undef;
+}
+
+=item $reactor->toggle_hook($id[, $status])
+
+Updates the status of the previously registered
+hook identified by C<$id>. The C<$status> parameter
+determines whether the hook is to be enabled or
+disabled.
+
+=cut
+
+sub toggle_hook {
+    my $self = shift;
+    my $key = shift;
+    my $enabled = shift;
+    
+    $self->{hooks}->[$key]->{enabled} = $enabled;
+}
+
+sub _add {
+    my $self = shift;
+    my $type = shift;
+    my $fd = shift;
+    my $callback = shift;
+    my $enabled = shift;
+    $enabled = 1 unless defined $enabled;
+    
+    $self->{fds}->{$type}->{$fd} = {
+	callback => $callback,
+	enabled => $enabled
+	};
+}
+
+=item $reactor->remove_read($fd);
+
+=item $reactor->remove_write($fd);
+
+=item $reactor->remove_exception($fd);
+
+Removes a watch on the file handle C<$fd>.
+
+=cut
+
+sub remove_read {
+    my $self = shift;
+    $self->_remove("read", @_);
+}
+
+sub remove_write {
+    my $self = shift;
+    $self->_remove("write", @_);
+}
+
+sub remove_exception {
+    my $self = shift;
+    $self->_remove("exception", @_);
+}
+
+sub _remove {
+    my $self = shift;
+    my $type = shift;
+    my $fd = shift;
+
+    die "no handle ($type) active with fd '$fd'" 
+	unless exists $self->{fds}->{$type}->{$fd};
+
+    delete $self->{fds}->{$type}->{$fd};
+}
+
+=item $reactor->toggle_read($fd, $status);
+
+=item $reactor->toggle_write($fd, $status);
+
+=item $reactor->toggle_exception($fd, $status);
+
+Updates the status of a watch on the file handle C<$fd>.
+The C<$status> parameter species whether the watch is
+to be enabled or disabled.
+
+=cut
+
+sub toggle_read {
+    my $self = shift;
+    $self->_toggle("read", @_);
+}
+
+sub toggle_write {
+    my $self = shift;
+    $self->_toggle("write", @_);
+}
+
+sub toggle_exception {
+    my $self = shift;
+    $self->_toggle("exception", @_);
+}
+
+sub _toggle {
+    my $self = shift;
+    my $type = shift;
+    my $fd = shift;
+    my $enabled = shift;
+
+    $self->{fds}->{$type}->{$fd}->{enabled} = $enabled;
+}
+
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Callback>, L<Net::DBus::Connection>, L<Net::DBus::Server>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan@berrange.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Daniel Berrange
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/RemoteObject.pm b/Net-DBus/lib/Net/DBus/RemoteObject.pm
new file mode 100644
index 0000000..e9fa0bb
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/RemoteObject.pm
@@ -0,0 +1,422 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::RemoteObject - Access objects provided on the bus
+
+=head1 SYNOPSIS
+
+  my $service = $bus->get_service("org.freedesktop.DBus");
+  my $object = $service->get_object("/org/freedesktop/DBus");
+
+  print "Names on the bus {\n";
+  foreach my $name (sort $object->ListNames) {
+      print "  ", $name, "\n";
+  }
+  print "}\n";
+
+=head1 DESCRIPTION
+
+This module provides the API for accessing remote objects available
+on the bus. It uses the autoloader to fake the presence of methods
+based on the API of the remote object. There is also support for
+setting callbacks against signals, and accessing properties of the
+object.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::RemoteObject;
+
+use 5.006;
+use strict;
+use warnings;
+
+our $AUTOLOAD;
+
+use Net::DBus::Binding::Introspector;
+use Net::DBus::ASyncReply;
+use Net::DBus::Annotation qw(:call);
+
+
+=item my $object = Net::DBus::RemoteObject->new($service, $object_path[, $interface]);
+
+Creates a new handle to a remote object. The C<$service> parameter is an instance
+of the L<Net::DBus::RemoteService> method, and C<$object_path> is the identifier of
+an object exported by this service, for example C</org/freedesktop/DBus>. For remote
+objects which implement more than one interface it is possible to specify an optional
+name of an interface as the third parameter. This is only really required, however, if
+two interfaces in the object provide methods with the same name, since introspection
+data can be used to automatically resolve the correct interface to call cases where
+method names are unique. Rather than using this constructor directly, it is preferrable
+to use the C<get_object> method on L<Net::DBus::RemoteService>, since this caches handles
+to remote objects, eliminating unneccessary introspection data lookups.
+
+=cut
+
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $self = {};
+
+    $self->{service} = shift;
+    $self->{object_path}  = shift;
+    $self->{interface} = @_ ? shift : undef;
+    $self->{introspected} = 0;
+
+    bless $self, $class;
+
+    return $self;
+}
+
+=item my $object = $object->as_interface($interface);
+
+Casts the object to a specific interface, returning a new instance of the
+L<Net::DBus::RemoteObject> specialized to the desired interface. It is only
+neccessary to cast objects to a specific interface, if two interfaces
+export methods or signals with the same name, or the remote object does not
+support introspection.
+
+=cut
+
+sub as_interface {
+    my $self = shift;
+    my $interface = shift;
+
+    die "already cast to " . $self->{interface} . "'"
+	if $self->{interface};
+
+    return $self->new($self->{service},
+		      $self->{object_path},
+		      $interface);
+}
+
+=item my $service = $object->get_service
+
+Retrieves a handle for the remote service on which this object is
+attached. The returned object is an instance of L<Net::DBus::RemoteService>
+
+=cut
+
+sub get_service {
+    my $self = shift;
+    return $self->{service};
+}
+
+=item my $path = $object->get_object_path
+
+Retrieves the unique path identifier for this object within the
+service.
+
+=cut
+
+sub get_object_path {
+    my $self = shift;
+    return $self->{object_path};
+}
+
+=item my $object = $object->get_child_object($subpath, [$interface])
+
+Retrieves a handle to a child of this object, identified
+by the relative path C<$subpath>. The returned object
+is an instance of C<Net::DBus::RemoteObject>. The optional
+C<$interface> parameter can be used to immediately cast
+the object to a specific type.
+
+=cut
+
+sub get_child_object {
+    my $self = shift;
+    my $path = shift;
+    my $interface = @_ ? shift : undef;
+    my $fullpath = $self->{object_path} . $path;
+
+    return $self->new($self->get_service,
+		      $fullpath,
+		      $interface);
+}
+
+sub _introspector {
+    my $self = shift;
+
+
+    unless ($self->{introspected}) {
+	my $con = $self->{service}->get_bus()->get_connection();
+
+	my $call = $con->make_method_call_message($self->{service}->get_service_name(),
+						  $self->{object_path},
+						  "org.freedesktop.DBus.Introspectable",
+						  "Introspect");
+
+	my $xml = eval {
+	    my $reply = $con->send_with_reply_and_block($call, 60 * 1000);
+
+	    my $iter = $reply->iterator;
+	    return $iter->get(&Net::DBus::Binding::Message::TYPE_STRING);
+	};
+	if ($@) {
+	    if (UNIVERSAL::isa($@, "Net::DBus::Error") &&
+		$@->{name} eq "org.freedesktop.DBus.Error.ServiceUnknown") {
+		die $@;
+	    } else {
+		# Ignore other failures, since its probably
+		# just that the object doesn't implement
+		# the introspect method. Of course without
+		# the introspect method we can't tell for sure
+		# if this is the case..
+		#warn "could not introspect object: $@";
+	    }
+	}
+	if ($xml) {
+	    $self->{introspector} = Net::DBus::Binding::Introspector->new(xml => $xml,
+									  object_path => $self->{object_path});
+	}
+	$self->{introspected} = 1;
+    }
+    return $self->{introspector};
+}
+
+
+=item $object->connect_to_signal($name, $coderef);
+
+Connects a callback to a signal emitted by the object. The C<$name>
+parameter is the name of the signal within the object, and C<$coderef>
+is a reference to an anonymous subroutine. When the signal C<$name>
+is emitted by the remote object, the subroutine C<$coderef> will be
+invoked, and passed the parameters from the signal.
+
+=cut
+
+sub connect_to_signal {
+    my $self = shift;
+    my $name = shift;
+    my $code = shift;
+
+    my $ins = $self->_introspector;
+    my $interface = $self->{interface};
+    if (!$interface) {
+	if (!$ins) {
+	    die "no introspection data available for '" . $self->get_object_path .
+		"', and object is not cast to any interface";
+	}
+	my @interfaces = $ins->has_signal($name);
+
+	if ($#interfaces == -1) {
+	    die "no signal with name '$name' is exported in object '" .
+		$self->get_object_path . "'\n";
+	} elsif ($#interfaces > 0) {
+	    warn "signal with name '$name' is exported " .
+		"in multiple interfaces of '" . $self->get_object_path . "'" .
+		"connecting to first interface only\n";
+	}
+	$interface = $interfaces[0];
+    }
+
+    if ($ins &&
+	$ins->has_signal($name, $interface) &&
+	$ins->is_signal_deprecated($name, $interface)) {
+	warn "signal $name in interface $interface on " . $self->get_object_path . " is deprecated";
+    }
+
+    $self->get_service->
+	get_bus()->
+	_add_signal_receiver(sub {
+	    my $signal = shift;
+	    my $ins = $self->_introspector;
+	    my @params;
+	    if ($ins) {
+		@params = $ins->decode($signal, "signals", $signal->get_member, "params");
+	    } else {
+		@params = $signal->get_args_list;
+	    }
+	    &$code(@params);
+	},
+			     $name,
+			     $interface,
+			     $self->{service}->get_owner_name(),
+			     $self->{object_path});
+}
+
+
+sub DESTROY {
+    # No op merely to stop AutoLoader trying to
+    # call DESTROY on remote object
+}
+
+sub AUTOLOAD {
+    my $self = shift;
+    my $sub = $AUTOLOAD;
+
+    my $mode = dbus_call_sync;
+    if (@_ && UNIVERSAL::isa($_[0], "Net::DBus::Annotation")) {
+	$mode = shift;
+    }
+
+    (my $name = $AUTOLOAD) =~ s/.*:://;
+
+    my $interface = $self->{interface};
+
+    # If introspection data is available, use that
+    # to resolve correct interface (if object is not
+    # cast to an explicit interface already)
+    my $ins = $self->_introspector();
+    if ($ins) {
+	if ($interface) {
+	    if ($ins->has_method($name, $interface)) {
+		return $self->_call_method($mode, $name, $interface, 1, @_);
+	    }
+	    if ($ins->has_property($name, $interface)) {
+		if ($ins->is_property_deprecated($name, $interface)) {
+		    warn "property $name in interface $interface on " . $self->get_object_path . " is deprecated";
+		}
+
+		if (@_) {
+		    $self->_call_method($mode, "Set", "org.freedesktop.DBus.Properties", $interface, 1, $name, $_[0]);
+		    return ();
+		} else {
+		    return $self->_call_method($mode, "Get", "org.freedesktop.DBus.Properties", $interface, 1, $name);
+		}
+	    }
+	} else {
+	    my @interfaces = $ins->has_method($name);
+
+	    if (@interfaces) {
+		if ($#interfaces > 0) {
+		    die "method with name '$name' is exported " .
+			"in multiple interfaces of '" . $self->get_object_path . "'";
+		}
+		return $self->_call_method($mode, $name, $interfaces[0], 1, @_);
+	    }
+	    @interfaces = $ins->has_property($name);
+
+	    if (@interfaces) {
+		if ($#interfaces > 0) {
+		    die "property with name '$name' is exported " .
+			"in multiple interfaces of '" . $self->get_object_path . "'";
+		}
+		$interface = $interfaces[0];
+		if ($ins->is_property_deprecated($name, $interface)) {
+		    warn "property $name in interface $interface on " . $self->get_object_path . " is deprecated";
+		}
+		if (@_) {
+		    $self->_call_method($mode, "Set", "org.freedesktop.DBus.Properties", $interface, 1, $name, $_[0]);
+		    return ();
+		} else {
+		    return $self->_call_method($mode, "Get", "org.freedesktop.DBus.Properties", $interface, 1, $name);
+		}
+	    }
+	}
+    }
+
+    if (!$interface) {
+	die "no introspection data available for method '" . $name . "' in object '" .
+	    $self->get_object_path . "', and object is not cast to any interface";
+    }
+
+    return $self->_call_method($mode, $name, $interface, 0, @_);
+}
+
+
+sub _call_method {
+    my $self = shift;
+    my $mode = shift;
+    my $name = shift;
+    my $interface = shift;
+    my $introspect = shift;
+
+    my $con = $self->{service}->get_bus()->get_connection();
+
+    my $ins = $introspect ? $self->_introspector : undef;
+    if ($ins &&
+	$ins->is_method_deprecated($name, $interface)) {
+	warn "method '$name' in interface $interface on object " . $self->get_object_path . " is deprecated\n";
+    }
+
+    my $call = $con->make_method_call_message($self->{service}->get_service_name(),
+					      $self->{object_path},
+					      $interface,
+					      $name);
+
+    #$call->set_destination($self->get_service->get_owner_name);
+
+    if ($ins) {
+	$ins->encode($call, "methods", $name, "params", @_);
+    } else {
+	$call->append_args_list(@_);
+    }
+
+    if ($mode == dbus_call_sync) {
+	my $reply = $con->
+	    send_with_reply_and_block($call, 60 * 1000);
+
+	my @reply;
+	if ($ins) {
+	    @reply = $ins->decode($reply, "methods", $name, "returns");
+	} else {
+	    @reply = $reply->get_args_list;
+	}
+
+	return wantarray ? @reply : $reply[0];
+    } elsif ($mode == dbus_call_async) {
+	my $pending_call = $self->{service}->
+	    get_bus()->
+	    get_connection()->
+	    send_with_reply($call, 60 * 1000);
+	my $reply = Net::DBus::ASyncReply->_new(pending_call => $pending_call,
+						($ins ? (introspector => $ins,
+							 method_name => $name)
+						 : ()));
+	return $reply;
+    } elsif ($mode == dbus_call_noreply) {
+	$call->set_no_reply(1);
+	$self->{service}->
+	    get_bus()->
+	    get_connection()->
+	    send($call, 60 * 1000);
+    } else {
+	die "unsupported annotation '$mode'";
+    }
+}
+
+
+1;
+
+=pod
+
+=back
+
+=head1 AUTHOR
+
+Daniel Berrange <dan@berrange.com>
+
+=head1 COPYRIGHT
+
+Copright (C) 2004-2005, Daniel Berrange.
+
+=head1 SEE ALSO
+
+L<Net::DBus::RemoteService>, L<Net::DBus::Object>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/RemoteService.pm b/Net-DBus/lib/Net/DBus/RemoteService.pm
new file mode 100644
index 0000000..a5d1737
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/RemoteService.pm
@@ -0,0 +1,171 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::RemoteService - Access services provided on the bus
+
+=head1 SYNOPSIS
+
+  my $bus = Net::DBus->find;
+  my $service = $bus->get_service("org.freedesktop.DBus");
+
+  my $object = $service->get_object("/org/freedesktop/DBus");
+  foreach (@{$object->ListNames}) {
+    print "$_\n";
+  }
+
+=head1 DESCRIPTION
+
+This object provides a handle to a remote service on the
+bus. From this handle it is possible to access objects
+associated with the service. If a service is not running,
+an attempt will be made to activate it the first time a
+method is called against one of its objects.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::RemoteService;
+
+use 5.006;
+use strict;
+use warnings;
+
+use Net::DBus::RemoteObject;
+
+=item my $service = Net::DBus::RemoteService->new($bus, $owner, $service_name);
+
+Creates a new handle for a remote service. The C<$bus> parameter is an
+instance of L<Net::DBus>, C<$owner> is the name of the client providing the
+service, while C<$service_name> is the well known name of the  service on 
+the bus. Service names consist of two or more tokens, separated
+by periods, while the tokens comprise the letters a-z, A-Z, 0-9 and _,
+for example C<org.freedesktop.DBus>. There is generally no need to call
+this constructor, instead the C<get_service> method on L<Net::DBus> should
+be used. This caches handles to remote services, eliminating repeated 
+retrieval of introspection data.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $self = {};
+
+    $self->{bus} = shift;
+    $self->{owner_name} = shift;
+    $self->{service_name} = shift;
+    $self->{objects} = {};
+
+    bless $self, $class;
+
+    return $self;
+}
+
+
+=item my $bus = $service->get_bus;
+
+Retrieves a handle for the bus to which this service is attached.
+The returned object will be an instance of L<Net::DBus>.
+
+=cut
+
+sub get_bus {
+    my $self = shift;
+
+    return $self->{bus};
+}
+
+
+=item my $service_name = $service->get_service_name
+
+Retrieves the name of the remote service as known to the bus.
+
+=cut
+
+sub get_service_name {
+    my $self = shift;
+    return $self->{service_name};
+}
+
+=item my $owner_name = $service->get_owner_name;
+
+Retrieves the name of the client owning the service at the
+time it was connected to. 
+
+=cut
+
+sub get_owner_name {
+    my $self = shift;
+    return $self->{owner_name};
+}
+
+=item my $object = $service->get_object($object_path[, $interface]);
+
+Retrieves a handle to the remote object provided by the service  with
+the name of C<$object_path>. If the optional C<$interface> parameter is
+provided, the object will immediately be cast to the designated 
+interface. NB, it is only neccessary to cast an object to a specific
+interface if there are multiple interfaces on the object providing
+methods with the same name, or the remote object does support 
+introspection. The returned object will be an instance of L<Net::DBus::RemoteObject>.
+
+=cut
+
+sub get_object {
+    my $self = shift;
+    my $object_path = shift;
+    
+    unless (defined $self->{objects}->{$object_path}) {
+	$self->{objects}->{$object_path} = Net::DBus::RemoteObject->new($self,
+									$object_path);
+    }
+
+    if (@_) {
+	my $interface = shift;
+	return $self->{objects}->{$object_path}->as_interface($interface);
+    } else {
+	return $self->{objects}->{$object_path};
+    }
+}
+
+1;
+ 
+
+=pod
+
+=back
+
+=head1 AUTHOR
+
+Daniel Berrange <dan@berrange.com>
+
+=head1 COPYRIGHT
+
+Copright (C) 2004-2005, Daniel Berrange. 
+
+=head1 SEE ALSO
+
+L<Net::DBus::RemoteObject>, L<Net::DBus::Service>, L<Net::DBus>
+
+=cut
diff --git a/Net-DBus/lib/Net/DBus/Service.pm b/Net-DBus/lib/Net/DBus/Service.pm
new file mode 100644
index 0000000..2b91c24
--- /dev/null
+++ b/Net-DBus/lib/Net/DBus/Service.pm
@@ -0,0 +1,151 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2006 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the same terms as Perl itself. Either:
+#
+# a) the GNU General Public License as published by the Free
+#   Software Foundation; either version 2, or (at your option) any
+#   later version,
+#
+# or
+#
+# b) the "Artistic License"
+#
+# The file "COPYING" distributed along with this file provides full
+# details of the terms and conditions of the two licenses.
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Service - Provide a service to the bus for clients to use
+
+=head1 SYNOPSIS
+
+  package main;
+
+  use Net::DBus;
+
+  # Attach to the bus
+  my $bus = Net::DBus->find;
+
+  # Acquire a service 'org.demo.Hello'
+  my $service = $bus->export_service("org.demo.Hello");
+
+  # Export our object within the service
+  my $object = Demo::HelloWorld->new($service);
+
+  ....rest of program...
+
+=head1 DESCRIPTION
+
+This module represents a service which is exported to the message
+bus. Once a service has been exported, it is possible to create
+and export objects to the bus.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+
+package Net::DBus::Service;
+
+use 5.006;
+use strict;
+use warnings;
+
+=item my $service = Net::DBus::Service->new($bus, $name);
+
+Create a new service, attaching to the bus provided in
+the C<$bus> parameter, which should be an instance of
+the L<Net::DBus> object. The C<$name> parameter is the
+qualified service name. It is not usually neccessary to
+use this constructor, since services can be created via
+the C<export_service> method on the L<Net::DBus> object.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $self = {};
+
+    $self->{bus} = shift;
+    $self->{service_name} = shift;
+    $self->{objects} = {};
+    
+    bless $self, $class;
+
+    $self->get_bus->get_connection->request_name($self->get_service_name);
+
+    return $self;
+}
+
+=item my $bus = $service->get_bus;
+
+Retrieves the L<Net::DBus> object to which this service is
+attached.
+
+=cut
+
+sub get_bus {
+    my $self = shift;
+    return $self->{bus};
+}
+
+=item my $name = $service->get_service_name
+
+Retrieves the qualified name by which this service is 
+known on the bus.
+
+=cut
+
+sub get_service_name {
+    my $self = shift;
+    return $self->{service_name};
+}
+
+
+sub _register_object {
+    my $self = shift;
+    my $object = shift;
+    #my $wildcard = shift || 0;
+    
+#    if ($wildcard) {
+#	$self->get_bus->get_connection->
+#	    register_fallback($object->get_object_path,
+#			      sub {
+#				  $object->_dispatch(@_);
+#			      });
+#    } else {
+	$self->get_bus->get_connection->
+	    register_object_path($object->get_object_path,
+				 sub {
+				     $object->_dispatch(@_);
+				 });
+#    }
+}
+
+
+sub _unregister_object {
+    my $self = shift;
+    my $object = shift;
+
+    $self->get_bus->get_connection->
+	unregister_object_path($object->get_object_path);
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::Object>, L<Net::DBus::RemoteService>
+
+=cut
diff --git a/Net-DBus/lib/Net/Makefile.am b/Net-DBus/lib/Net/Makefile.am
new file mode 100644
index 0000000..0975a6f
--- /dev/null
+++ b/Net-DBus/lib/Net/Makefile.am
@@ -0,0 +1,3 @@
+SUBDIRS = DBus
+
+EXTRA_DIST = DBus.pm
diff --git a/Net-DBus/typemap b/Net-DBus/typemap
new file mode 100644
index 0000000..36c887f
--- /dev/null
+++ b/Net-DBus/typemap
@@ -0,0 +1,109 @@
+TYPEMAP
+const char *    T_PV
+DBusConnection*	O_OBJECT_connection
+DBusServer*	O_OBJECT_server
+DBusMessage*	O_OBJECT_message
+DBusPendingCall* O_OBJECT_pendingcall
+DBusWatch*      O_OBJECT_watch
+DBusTimeout*      O_OBJECT_timeout
+DBusMessageIter* O_OBJECT_messageiter
+DBusBusType T_IV
+dbus_bool_t T_BOOL
+dbus_int16_t T_IV
+dbus_uint16_t T_UV
+dbus_int32_t T_IV
+dbus_uint32_t T_UV
+dbus_int64_t T_IV
+dbus_uint64_t T_UV
+
+INPUT
+O_OBJECT_connection
+    if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
+        $var = ($type)SvIV((SV*)SvRV( $arg ));
+    else {
+        warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+        XSRETURN_UNDEF;
+    }
+
+OUTPUT
+O_OBJECT_connection
+        sv_setref_pv( $arg, "Net::DBus::Binding::C::Connection", (void*)$var );
+
+INPUT
+O_OBJECT_server
+    if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
+        $var = ($type)SvIV((SV*)SvRV( $arg ));
+    else {
+        warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+        XSRETURN_UNDEF;
+    }
+
+OUTPUT
+O_OBJECT_server
+        sv_setref_pv( $arg, "Net::DBus::Binding::C::Server", (void*)$var );
+
+INPUT
+O_OBJECT_message
+    if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
+        $var = ($type)SvIV((SV*)SvRV( $arg ));
+    else {
+        warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+        XSRETURN_UNDEF;
+    }
+
+OUTPUT
+O_OBJECT_message
+        sv_setref_pv( $arg, "Net::DBus::Binding::C::Message", (void*)$var );
+
+
+INPUT
+O_OBJECT_pendingcall
+    if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
+        $var = ($type)SvIV((SV*)SvRV( $arg ));
+    else {
+        warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+        XSRETURN_UNDEF;
+    }
+
+OUTPUT
+O_OBJECT_pendingcall
+        sv_setref_pv( $arg, "Net::DBus::Binding::C::PendingCall", (void*)$var );
+
+INPUT
+O_OBJECT_watch
+    if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
+        $var = ($type)SvIV((SV*)SvRV( $arg ));
+    else {
+        warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+        XSRETURN_UNDEF;
+    }
+
+OUTPUT
+O_OBJECT_watch
+        sv_setref_pv( $arg, "Net::DBus::Binding::C::Watch", (void*)$var );
+
+INPUT
+O_OBJECT_timeout
+    if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
+        $var = ($type)SvIV((SV*)SvRV( $arg ));
+    else {
+        warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+        XSRETURN_UNDEF;
+    }
+
+OUTPUT
+O_OBJECT_timeout
+        sv_setref_pv( $arg, "Net::DBus::Binding::C::Timeout", (void*)$var );
+
+INPUT
+O_OBJECT_messageiter
+    if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
+        $var = ($type)SvIV((SV*)SvRV( $arg ));
+    else {
+        warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+        XSRETURN_UNDEF;
+    }
+
+OUTPUT
+O_OBJECT_messageiter
+        sv_setref_pv( $arg, "Net::DBus::Binding::Iterator", (void*)$var );