[libnet-dbus-perl] 01/335: Initial commit
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:09 UTC 2015
This is an automated email from the git hooks/post-receive script.
intrigeri pushed a commit to branch experimental
in repository libnet-dbus-perl.
commit de226ccfe3d8755b742d57df3f4bd8744cba8bed
Author: Daniel P. Berrange <dan at berrange.com>
Date: Thu Aug 5 08:14:18 2004 +0000
Initial commit
---
.hgignore | 6 +
DBus.xs | 633 +++++++++++++++++++++++++++++++++++++++
Makefile.PL | 29 ++
README | 38 +++
lib/DBus.pm | 56 ++++
lib/DBus/Bus.pm | 51 ++++
lib/DBus/Connection.pm | 122 ++++++++
lib/DBus/Iterator.pm | 63 ++++
lib/DBus/Message.pm | 109 +++++++
lib/DBus/Message/Error.pm | 35 +++
lib/DBus/Message/MethodCall.pm | 34 +++
lib/DBus/Message/MethodReturn.pm | 31 ++
lib/DBus/Message/Signal.pm | 34 +++
lib/DBus/Reactor.pm | 245 +++++++++++++++
lib/DBus/Server.pm | 132 ++++++++
lib/DBus/Watch.pm | 32 ++
t/1.t | 52 ++++
t/2.t | 24 ++
t/3.t | 24 ++
t/4.t | 21 ++
t/5.t | 39 +++
t/6.t | 58 ++++
typemap | 78 +++++
23 files changed, 1946 insertions(+)
diff --git a/.hgignore b/.hgignore
new file mode 100644
index 0000000..0d149c2
--- /dev/null
+++ b/.hgignore
@@ -0,0 +1,6 @@
+(^|/)CVS($|/)
+(^|/)\.hg($|/)
+(^|/)\.hgtags($|/)
+^state$
+^state.old$
+^state.journal$
diff --git a/DBus.xs b/DBus.xs
new file mode 100644
index 0000000..8c20349
--- /dev/null
+++ b/DBus.xs
@@ -0,0 +1,633 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <dbus/dbus.h>
+
+
+dbus_bool_t
+_watch_generic(DBusWatch *watch, void *data, char *key) {
+ HV *self = (HV*)SvRV((SV*)data);
+ SV **call;
+ SV *h_sv1;
+ SV *h_sv2;
+ dSP;
+printf("In watxh %x %x %s\n", data, self, key);
+
+ call = hv_fetch(self, key, strlen(key), 0);
+
+ if (!call) {
+printf("Could not find call %s\n", key);
+ return FALSE;
+ }
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ XPUSHs((SV*)data);
+ h_sv2 = sv_newmortal();
+ sv_setref_pv(h_sv2, "DBus::C::Watch", (void*)watch);
+ XPUSHs(h_sv2);
+ PUTBACK;
+
+ call_sv(*call, G_DISCARD);
+
+ FREETMPS;
+ LEAVE;
+}
+
+dbus_bool_t
+_watch_server_add(DBusWatch *watch, void *data) {
+ return _watch_generic(watch, data, "add_watch");
+}
+void
+_watch_server_remove(DBusWatch *watch, void *data) {
+ _watch_generic(watch, data, "remove_watch");
+}
+void
+_watch_server_toggled(DBusWatch *watch, void *data) {
+ _watch_generic(watch, data, "toggled_watch");
+}
+
+void
+_connection_callback (DBusServer *server,
+ DBusConnection *new_connection,
+ void *data) {
+ HV *self = (HV *)SvRV((SV*)data);
+ SV **call;
+ SV *proto;
+ SV *name;
+ SV *value;
+ SV *h_sv;
+ dSP;
+
+ call = hv_fetch(self, "_callback", strlen("_callback"), 0);
+
+ if (!call) {
+ return;
+ }
+
+ dbus_connection_ref(new_connection);
+
+ value = sv_newmortal();
+ sv_setref_pv(value, "DBus::C::Connection", (void*)new_connection);
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ XPUSHs((SV*)data);
+ XPUSHs(value);
+ PUTBACK;
+
+ call_sv(*call, G_DISCARD);
+
+ FREETMPS;
+ LEAVE;
+}
+
+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 = DBus PACKAGE = DBus
+
+PROTOTYPES: ENABLE
+BOOT:
+ {
+ HV *constants;
+
+ /* not the 'standard' way of doing perl constants, but a lot easier to maintain */
+
+ constants = perl_get_hv("DBus::Bus::_constants", TRUE);
+ REGISTER_CONSTANT(DBUS_BUS_SYSTEM, SYSTEM);
+ REGISTER_CONSTANT(DBUS_BUS_SESSION, SESSION);
+ REGISTER_CONSTANT(DBUS_BUS_ACTIVATION, ACTIVATION);
+
+ constants = perl_get_hv("DBus::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_CUSTOM, TYPE_CUSTOM);
+ REGISTER_CONSTANT(DBUS_TYPE_DICT, TYPE_DICT);
+ REGISTER_CONSTANT(DBUS_TYPE_DOUBLE, TYPE_DOUBLE);
+ 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_NIL, TYPE_NIL);
+ REGISTER_CONSTANT(DBUS_TYPE_OBJECT_PATH, TYPE_OBJECT_PATH);
+ REGISTER_CONSTANT(DBUS_TYPE_STRING, TYPE_STRING);
+ REGISTER_CONSTANT(DBUS_TYPE_UINT32, TYPE_UINT32);
+ REGISTER_CONSTANT(DBUS_TYPE_UINT64, TYPE_UINT64);
+
+ constants = perl_get_hv("DBus::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);
+ }
+
+
+MODULE = DBus::Connection PACKAGE = DBus::Connection
+
+PROTOTYPES: ENABLE
+
+void
+_open(address)
+ char *address;
+ PREINIT:
+ DBusError error;
+ DBusConnection *con;
+ SV *h_sv;
+ PPCODE:
+ dbus_error_init(&error);
+ con = dbus_connection_open(address, &error);
+ if (!con) {
+ // XXX fixme
+ //dbus_error_free(&error);
+ croak(error.message);
+ }
+ h_sv = sv_newmortal();
+ sv_setref_pv(h_sv, "DBus::C::Connection", (void*)con);
+
+ PUSHs(h_sv);
+
+MODULE = DBus::C::Connection PACKAGE = DBus::C::Connection
+
+void
+dbus_connection_disconnect(con)
+ DBusConnection *con;
+
+int
+dbus_connection_get_is_connected(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
+
+void
+_set_watch_callbacks(con, self)
+ DBusConnection *con;
+ SV *self;
+ PPCODE:
+ SvREFCNT_inc(self);
+ if (!dbus_connection_set_watch_functions(con,
+ _watch_server_add,
+ _watch_server_remove,
+ _watch_server_toggled,
+ self, NULL)) {
+ croak("not enough memory to set watch functions on connection");
+ }
+
+void
+dbus_connection_unref(con)
+ DBusConnection *con;
+
+
+MODULE = DBus::Server PACKAGE = DBus::Server
+
+PROTOTYPES: ENABLE
+
+void
+_open(address)
+ char *address;
+ PREINIT:
+ DBusError error;
+ DBusServer *server;
+ SV *h_sv;
+ PPCODE:
+ dbus_error_init(&error);
+ server = dbus_server_listen(address, &error);
+ if (!server) {
+ // XXX fixme
+ //dbus_error_free(&error);
+ croak(error.message);
+ }
+ h_sv = sv_newmortal();
+ sv_setref_pv(h_sv, "DBus::C::Server", (void*)server);
+
+ if (!dbus_server_set_auth_mechanisms(server, NULL)) {
+ croak("not enough memory to server auth mechanisms");
+ }
+
+ PUSHs(h_sv);
+
+MODULE = DBus::C::Server PACKAGE = DBus::C::Server
+
+void
+dbus_server_disconnect(server)
+ DBusServer *server;
+
+int
+dbus_server_get_is_connected(server)
+ DBusServer *server;
+
+void
+_set_watch_callbacks(server, self)
+ DBusServer *server;
+ SV *self;
+ PPCODE:
+ SvREFCNT_inc(self);
+ printf("Setting2 %x %x %x\n", server, self, SvRV(self));
+ if (!dbus_server_set_watch_functions(server,
+ _watch_server_add,
+ _watch_server_remove,
+ _watch_server_toggled,
+ self, NULL)) {
+ croak("not enough memory to set watch functions on server");
+ }
+
+
+void
+_set_connection_callback(server, self)
+ DBusServer *server;
+ SV *self;
+ PPCODE:
+ SvREFCNT_inc(self);
+ printf("Setting %x %x %x\n", server, self, SvRV(self));
+ dbus_server_set_new_connection_function(server,
+ _connection_callback,
+ self, NULL);
+
+void
+dbus_server_unref(server)
+ DBusServer *server;
+
+
+MODULE = DBus::Bus PACKAGE = DBus::Bus
+
+PROTOTYPES: ENABLE
+
+void
+_open(type)
+ DBusBusType type;
+ PREINIT:
+ DBusError error;
+ DBusConnection *con;
+ SV *h_sv;
+ PPCODE:
+ dbus_error_init(&error);
+ con = dbus_bus_get(type, &error);
+ if (!con) {
+ // XXX fixme
+ //dbus_error_free(error);
+ croak(error.message);
+ }
+ h_sv = sv_newmortal();
+ sv_setref_pv(h_sv, "DBus::C::Connection", (void*)con);
+
+ PUSHs(h_sv);
+
+MODULE = DBus::Message PACKAGE = DBus::Message
+
+PROTOTYPES: ENABLE
+
+void
+_create(type)
+ IV type;
+ PREINIT:
+ DBusMessage *msg;
+ SV *h_sv;
+ PPCODE:
+ msg = dbus_message_new(type);
+ if (!msg) {
+ croak("No memory to allocate message");
+ }
+ h_sv = sv_newmortal();
+ sv_setref_pv(h_sv, "DBus::C::Message", (void*)msg);
+
+ PUSHs(h_sv);
+
+void
+set_no_reply(msg, status)
+ DBusMessage *msg;
+ dbus_bool_t status;
+ PPCODE:
+ dbus_message_set_no_reply(msg, status);
+
+void
+set_auto_activation(msg, status)
+ DBusMessage *msg;
+ dbus_bool_t status;
+ PPCODE:
+ dbus_message_set_auto_activation(msg, status);
+
+void
+_destroy(msg)
+ DBusMessage *msg;
+ PPCODE:
+ dbus_message_unref(msg);
+
+void
+_iterator(msg)
+ DBusMessage *msg;
+ PREINIT:
+ DBusMessageIter *iter;
+ SV *h_sv;
+ PPCODE:
+ iter = dbus_new(DBusMessageIter, 1);
+ dbus_message_iter_init(msg, iter);
+ h_sv = sv_newmortal();
+ sv_setref_pv(h_sv, "DBus::C::Iterator", iter);
+ PUSHs(h_sv);
+
+MODULE = DBus::Message::Signal PACKAGE = DBus::Message::Signal
+
+PROTOTYPES: ENABLE
+
+void
+_create(path, interface, name)
+ char *path;
+ char *interface;
+ char *name;
+ PREINIT:
+ DBusMessage *msg;
+ SV *h_sv;
+ PPCODE:
+ msg = dbus_message_new_signal(path, interface, name);
+ if (!msg) {
+ croak("No memory to allocate message");
+ }
+ h_sv = sv_newmortal();
+ sv_setref_pv(h_sv, "DBus::C::Message", (void*)msg);
+
+ PUSHs(h_sv);
+
+MODULE = DBus::Message::MethodCall PACKAGE = DBus::Message::MethodCall
+
+PROTOTYPES: ENABLE
+
+void
+_create(service, path, interface, method)
+ char *service;
+ char *path;
+ char *interface;
+ char *method;
+ PREINIT:
+ DBusMessage *msg;
+ SV *h_sv;
+ PPCODE:
+ msg = dbus_message_new_method_call(service, path, interface, method);
+ if (!msg) {
+ croak("No memory to allocate message");
+ }
+ h_sv = sv_newmortal();
+ sv_setref_pv(h_sv, "DBus::C::Message", (void*)msg);
+
+ PUSHs(h_sv);
+
+MODULE = DBus::Message::MethodReturn PACKAGE = DBus::Message::MethodReturn
+
+PROTOTYPES: ENABLE
+
+void
+_create(call)
+ DBusMessage *call;
+ PREINIT:
+ DBusMessage *msg;
+ SV *h_sv;
+ PPCODE:
+ msg = dbus_message_new_method_return(call);
+ if (!msg) {
+ croak("No memory to allocate message");
+ }
+ h_sv = sv_newmortal();
+ sv_setref_pv(h_sv, "DBus::C::Message", (void*)msg);
+
+ PUSHs(h_sv);
+
+MODULE = DBus::Message::Error PACKAGE = DBus::Message::Error
+
+PROTOTYPES: ENABLE
+
+void
+_create(replyto, name, message)
+ DBusMessage *replyto;
+ char *name;
+ char *message;
+ PREINIT:
+ DBusMessage *msg;
+ SV *h_sv;
+ PPCODE:
+ msg = dbus_message_new_error(replyto, name, message);
+ if (!msg) {
+ croak("No memory to allocate message");
+ }
+ h_sv = sv_newmortal();
+ sv_setref_pv(h_sv, "DBus::C::Message", (void*)msg);
+
+ PUSHs(h_sv);
+
+
+MODULE = DBus::C::Watch PACKAGE = DBus::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;
+ PPCODE:
+ printf("Handling event %d\n", flags);
+ dbus_watch_handle(watch, flags);
+
+MODULE = DBus::Iterator PACKAGE = DBus::Iterator
+
+int
+get_arg_type(iter)
+ DBusMessageIter *iter;
+ CODE:
+ RETVAL = dbus_message_iter_get_arg_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:
+ RETVAL = dbus_message_iter_get_boolean(iter);
+ OUTPUT:
+ RETVAL
+
+unsigned char
+get_byte(iter)
+ DBusMessageIter *iter;
+ CODE:
+ RETVAL = dbus_message_iter_get_byte(iter);
+ OUTPUT:
+ RETVAL
+
+dbus_int32_t
+get_int32(iter)
+ DBusMessageIter *iter;
+ CODE:
+ RETVAL = dbus_message_iter_get_int32(iter);
+ OUTPUT:
+ RETVAL
+
+dbus_uint32_t
+get_uint32(iter)
+ DBusMessageIter *iter;
+ CODE:
+ RETVAL = dbus_message_iter_get_uint32(iter);
+ OUTPUT:
+ RETVAL
+
+dbus_int64_t
+get_int64(iter)
+ DBusMessageIter *iter;
+ CODE:
+ RETVAL = dbus_message_iter_get_int64(iter);
+ OUTPUT:
+ RETVAL
+
+dbus_uint64_t
+get_uint64(iter)
+ DBusMessageIter *iter;
+ CODE:
+ RETVAL = dbus_message_iter_get_uint64(iter);
+ OUTPUT:
+ RETVAL
+
+double
+get_double(iter)
+ DBusMessageIter *iter;
+ CODE:
+ RETVAL = dbus_message_iter_get_double(iter);
+ OUTPUT:
+ RETVAL
+
+char *
+get_string(iter)
+ DBusMessageIter *iter;
+ CODE:
+ RETVAL = dbus_message_iter_get_string(iter);
+ OUTPUT:
+ RETVAL
+
+
+void
+append_nil(iter)
+ DBusMessageIter *iter;
+ PPCODE:
+ dbus_message_iter_append_nil(iter);
+
+void
+append_boolean(iter, val)
+ DBusMessageIter *iter;
+ dbus_bool_t val;
+ PPCODE:
+ dbus_message_iter_append_boolean(iter, val);
+
+void
+append_byte(iter, val)
+ DBusMessageIter *iter;
+ unsigned char val;
+ PPCODE:
+ dbus_message_iter_append_byte(iter, val);
+
+void
+append_int32(iter, val)
+ DBusMessageIter *iter;
+ dbus_int32_t val;
+ PPCODE:
+ dbus_message_iter_append_int32(iter, val);
+
+void
+append_uint32(iter, val)
+ DBusMessageIter *iter;
+ dbus_uint32_t val;
+ PPCODE:
+ dbus_message_iter_append_uint32(iter, val);
+
+void
+append_int64(iter, val)
+ DBusMessageIter *iter;
+ dbus_int64_t val;
+ PPCODE:
+ dbus_message_iter_append_int64(iter, val);
+
+void
+append_uint64(iter, val)
+ DBusMessageIter *iter;
+ dbus_uint64_t val;
+ PPCODE:
+ dbus_message_iter_append_uint64(iter, val);
+
+void
+append_double(iter, val)
+ DBusMessageIter *iter;
+ double val;
+ PPCODE:
+ dbus_message_iter_append_double(iter, val);
+
+void
+append_string(iter, val)
+ DBusMessageIter *iter;
+ char *val;
+ PPCODE:
+ dbus_message_iter_append_string(iter, val);
+
+void
+dbus_free(iter)
+ DBusMessageIter *iter;
+
+MODULE = DBus PACKAGE = DBus
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..5f6c2b5
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,29 @@
+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.
+
+WriteMakefile(
+ 'NAME' => 'DBus',
+ 'VERSION_FROM' => 'lib/DBus.pm', # finds $VERSION
+ 'PREREQ_PM' => {'Test::More' => 0}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/DBus.pm', # retrieve abstract from module
+ AUTHOR => 'Daniel Berrange <dan at berrange.com>') : ()),
+ 'LIBS' => ['-L/home/dan/usr/dbus-cvs/lib -ldbus-1'], # e.g., '-lm'
+ 'DEFINE' => '-DDBUS_API_SUBJECT_TO_CHANGE', # e.g., '-DHAVE_SOMETHING'
+ 'INC' => '-I. -I/home/dan/usr/dbus-cvs/include/dbus-1.0 -I/home/dan/usr/dbus-cvs/lib/dbus-1.0/include', # e.g., '-I. -I/usr/include/other'
+ # Un-comment this if you add C files to link with later:
+ # 'OBJECT' => '$(O_FILES)', # link all the C files too
+);
+
+package MY;
+
+sub libscan
+ {
+ my ($self, $path) = @_;
+ ($path =~ /\~$/) ? undef : $path;
+ }
+
+
+__END__
diff --git a/README b/README
new file mode 100644
index 0000000..1bc7ea7
--- /dev/null
+++ b/README
@@ -0,0 +1,38 @@
+DBus version 0.01
+=================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ Test::More
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2004 Daniel Berrange
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
diff --git a/lib/DBus.pm b/lib/DBus.pm
new file mode 100644
index 0000000..afecea7
--- /dev/null
+++ b/lib/DBus.pm
@@ -0,0 +1,56 @@
+package DBus;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use AutoLoader;
+
+our $VERSION = '0.01';
+
+require XSLoader;
+XSLoader::load('DBus', $VERSION);
+
+1;
+__END__
+
+=head1 NAME
+
+DBus - Perl extension for the DBus message system
+
+=head1 SYNOPSIS
+
+ use DBus::Connection;
+ use DBus::Server;
+
+=head1 ABSTRACT
+
+DBus provides a Perl API for the DBus message system.
+
+=head1 DESCRIPTION
+
+DBus provides a Perl API for the DBus message system.
+There is no need to access this module directly. It is
+used by other DBus::* module to trigger the autoloading
+of the XS module containing the interface to the DBus
+API
+
+=head1 SEE ALSO
+
+L<DBus::Connection>, L<DBus::Server>, L<DBus::Message>, L<DBus::Reactor>,
+L<DBus::Bus>, L<DBus::Watch>, L<DBus::Iterator>,
+L<dbus-monitor(1)>, L<dbus-daemon-1(1)>, L<dbus-send(1)>, L<http://dbus.freedesktop.org>,
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan at berrange.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004 by Daniel Berrange
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBus/Bus.pm b/lib/DBus/Bus.pm
new file mode 100644
index 0000000..a64d190
--- /dev/null
+++ b/lib/DBus/Bus.pm
@@ -0,0 +1,51 @@
+package DBus::Bus;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+use DBus::Connection;
+
+our @ISA = qw(Exporter DBus::Connection);
+
+our $VERSION = '0.0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+
+ my $connection = DBus::Bus::_open($params{type} ? $params{type} : confess "type parameter is required");
+
+ my $self = $class->SUPER::new(%params, connection => $connection);
+
+ bless $self, $class;
+
+ return $self;
+}
+
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function.
+
+ my $constname;
+ our $AUTOLOAD;
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+
+ croak "&DBus::Bus::constant not defined" if $constname eq '_constant';
+
+ if (!exists $DBus::Bus::_constants{$constname}) {
+ croak "no such constant \$DBus::Bus::$constname";
+ }
+
+ {
+ no strict 'refs';
+ *$AUTOLOAD = sub { $DBus::Bus::_constants{$constname} };
+ }
+ goto &$AUTOLOAD;
+}
+
+1;
+
diff --git a/lib/DBus/Connection.pm b/lib/DBus/Connection.pm
new file mode 100644
index 0000000..42f750d
--- /dev/null
+++ b/lib/DBus/Connection.pm
@@ -0,0 +1,122 @@
+=pod
+
+=head1 NAME
+
+DBus::Connection - A connection between client and server
+
+=head1 SYNOPSIS
+
+Creating a connection to a server and sending a message
+
+ use DBus::Connection;
+
+ my $con = DBus::Connection->new(address => "unix:path=/path/to/socket");
+
+ $con->send($message);
+
+=head1 DESCRIPTION
+
+An outgoing connection to a server, or an incoming connection
+from a client.
+
+=cut
+
+package DBus::Connection;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+
+our $VERSION = '0.0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+ my $self = {};
+
+ $self->{address} = exists $params{address} ? $params{address} : (exists $params{connection} ? "" : confess "address parameter is required");
+ $self->{connection} = exists $params{connection} ? $params{connection} : DBus::Connection::_open($self->{address});
+
+ bless $self, $class;
+
+ return $self;
+}
+
+
+sub is_connected {
+ my $self = shift;
+
+ return $self->{connection}->dbus_connection_get_is_connected();
+}
+
+
+sub disconnect {
+ my $self = shift;
+
+ $self->{connection}->dbus_connection_disconnect();
+}
+
+
+sub flush {
+ my $self = shift;
+
+ $self->{connection}->dbus_connection_flush();
+}
+
+
+sub send {
+ my $self = shift;
+ my $msg = shift;
+
+ return $self->{connection}->_send($msg->{message});
+}
+
+
+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($self);
+}
+
+
+sub DESTROY {
+ my $self = shift;
+
+ print "DESTROy $self $self->{connection}\n";
+ if ($self->{connection}->dbus_connection_get_is_connected()) {
+ $self->{connection}->dbus_connection_disconnect();
+ }
+ $self->{connection}->dbus_connection_unref();
+}
+
+1;
+
+=pod
+
+=head1 SEE ALSO
+
+L<DBus::Server>, L<DBus::Bus>, L<DBus::Message::Signal>, L<DBus::Message::MethodCall>, L<DBus::Message::MethodReturn>, L<DBus::Message::Error>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan at berrange.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004 by Daniel Berrange
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBus/Iterator.pm b/lib/DBus/Iterator.pm
new file mode 100644
index 0000000..bdb75cf
--- /dev/null
+++ b/lib/DBus/Iterator.pm
@@ -0,0 +1,63 @@
+=pod
+
+=head1 NAME
+
+DBus::Iterator - Reading and writing message parameters
+
+=head1 SYNOPSIS
+
+Creating a new message
+
+ my $msg = new DBus::Message::Signal;
+ my $iterator = $msg->iterator;
+
+ $iterator->append_boolean(1);
+ $iterator->append_byte(123);
+
+=head1 DESCRIPTION
+
+Provides an iterator for reading and writing messages
+parameters.
+
+=cut
+
+package DBus::Iterator;
+
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+
+our $VERSION = '0.0.1';
+
+
+sub DESTROY {
+ my $self = shift;
+
+ $self->dbus_free();
+}
+
+
+1;
+
+=pod
+
+=head1 SEE ALSO
+
+L<DBus::Message>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan at berrange.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004 by Daniel Berrange
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBus/Message.pm b/lib/DBus/Message.pm
new file mode 100644
index 0000000..b34cbff
--- /dev/null
+++ b/lib/DBus/Message.pm
@@ -0,0 +1,109 @@
+=pod
+
+=head1 NAME
+
+DBus::Message - Base class for messages
+
+=head1 SYNOPSIS
+
+Sending a message
+
+ my $msg = new DBus::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<DBus::Message::Signal>,
+L<DBus::Message::MethodCall>, L<DBus::Message::MethodReturn>,
+L<DBus::Message::Error> should be used.
+
+=cut
+
+package DBus::Message;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+use DBus::Iterator;
+
+our $VERSION = '0.0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+ my $self = {};
+
+ $self->{message} = exists $params{message} ? $params{message} :
+ (DBus::Message::_create(exists $params{type} ? $params{type} : confess "type parameter is required"));
+
+ bless $self, $class;
+
+ return $self;
+}
+
+
+sub iterator {
+ my $self = shift;
+
+ return DBus::Message::_iterator($self->{message});
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ DBus::Message::_destroy($self->{message});
+}
+
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function.
+
+ my $constname;
+ our $AUTOLOAD;
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+
+ croak "&DBus::Message::constant not defined" if $constname eq '_constant';
+
+ if (!exists $DBus::Message::_constants{$constname}) {
+ croak "no such constant \$DBus::Message::$constname";
+ }
+
+ {
+ no strict 'refs';
+ *$AUTOLOAD = sub { $DBus::Message::_constants{$constname} };
+ }
+ goto &$AUTOLOAD;
+}
+
+1;
+
+=pod
+
+=head1 SEE ALSO
+
+L<DBus::Server>, L<DBus::Connection>, L<DBus::Message::Signal>, L<DBus::Message::MethodCall>, L<DBus::Message::MethodReturn>, L<DBus::Message::Error>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan at berrange.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004 by Daniel Berrange
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBus/Message/Error.pm b/lib/DBus/Message/Error.pm
new file mode 100644
index 0000000..e997a7e
--- /dev/null
+++ b/lib/DBus/Message/Error.pm
@@ -0,0 +1,35 @@
+package DBus::Message::Error;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+use DBus::Message;
+
+our @ISA = qw(Exporter DBus::Message);
+
+our $VERSION = '0.0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+
+ my $replyto = exists $params{replyto} ? $params{replyto} : confess "replyto parameter is required";
+
+ my $msg = DBus::Message::Error::_create
+ (
+ $replyto->{message},
+ $params{name} ? $params{name} : confess "name parameter is required",
+ $params{message} ? $params{message} : confess "message parameter is required");
+
+ my $self = $class->SUPER::new(%params, message => $msg);
+
+ bless $self, $class;
+
+ return $self;
+}
+
+1;
diff --git a/lib/DBus/Message/MethodCall.pm b/lib/DBus/Message/MethodCall.pm
new file mode 100644
index 0000000..0ea014c
--- /dev/null
+++ b/lib/DBus/Message/MethodCall.pm
@@ -0,0 +1,34 @@
+package DBus::Message::MethodCall;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+use DBus::Message;
+
+our @ISA = qw(Exporter DBus::Message);
+
+our $VERSION = '0.0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+
+ my $msg = DBus::Message::MethodCall::_create
+ (
+ ($params{service} ? $params{service} : confess "service parameter is required"),
+ ($params{path} ? $params{path} : confess "path parameter is required"),
+ ($params{interface} ? $params{interface} : confess "interface parameter is required"),
+ ($params{method} ? $params{method} : confess "method parameter is required"));
+
+ my $self = $class->SUPER::new(%params, message => $msg);
+
+ bless $self, $class;
+
+ return $self;
+}
+
+1;
diff --git a/lib/DBus/Message/MethodReturn.pm b/lib/DBus/Message/MethodReturn.pm
new file mode 100644
index 0000000..d86ce65
--- /dev/null
+++ b/lib/DBus/Message/MethodReturn.pm
@@ -0,0 +1,31 @@
+package DBus::Message::MethodReturn;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+use DBus::Message;
+
+our @ISA = qw(Exporter DBus::Message);
+
+our $VERSION = '0.0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+
+ my $call = exists $params{call} ? $params{call} : confess "call parameter is required";
+
+ my $msg = DBus::Message::MethodReturn::_create($call->{message});
+
+ my $self = $class->SUPER::new(%params, message => $msg);
+
+ bless $self, $class;
+
+ return $self;
+}
+
+1;
diff --git a/lib/DBus/Message/Signal.pm b/lib/DBus/Message/Signal.pm
new file mode 100644
index 0000000..a779006
--- /dev/null
+++ b/lib/DBus/Message/Signal.pm
@@ -0,0 +1,34 @@
+package DBus::Message::Signal;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+use DBus::Message;
+
+our @ISA = qw(Exporter DBus::Message);
+
+our $VERSION = '0.0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+
+ my $msg = DBus::Message::Signal::_create
+ (
+ ($params{path} ? $params{path} : confess "path parameter is required"),
+ ($params{interface} ? $params{interface} : confess "interface parameter is required"),
+ ($params{name} ? $params{name} : confess "name parameter is required"));
+
+ my $self = $class->SUPER::new(%params, message => $msg);
+
+ bless $self, $class;
+
+ return $self;
+}
+
+
+1;
diff --git a/lib/DBus/Reactor.pm b/lib/DBus/Reactor.pm
new file mode 100644
index 0000000..d0e685c
--- /dev/null
+++ b/lib/DBus/Reactor.pm
@@ -0,0 +1,245 @@
+package DBus::Reactor;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+use DBus::Watch;
+
+our $VERSION = '0.0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+ my $self = {};
+
+ $self->{fds} = {
+ read => {},
+ write => {},
+ exception => {}
+ };
+
+ bless $self, $class;
+
+ return $self;
+}
+
+
+sub manage {
+ my $self = shift;
+ my $connection = shift;
+
+ $connection->set_watch_callbacks(sub {
+ my $connection = shift;
+ my $watch = shift;
+ print "On $watch " . $watch->get_fileno . " " . $watch->get_flags . "\n";
+ $self->_manage_on($watch);
+ }, sub {
+ my $connection = shift;
+ my $watch = shift;
+ print "Off $watch " . $watch->get_fileno . " " . $watch->get_flags . "\n";
+ $self->_manage_off($watch);
+ }, sub {
+ my $connection = shift;
+ my $watch = shift;
+ print "Toggle $watch " . $watch->get_fileno . " " . $watch->get_flags . " " . $watch->is_enabled() . "\n";
+ $self->_manage_state($watch);
+ });
+}
+
+
+
+sub _manage_on {
+ my $self = shift;
+ my $watch = shift;
+ my $flags = $watch->get_flags;
+
+ if ($flags & &DBus::Watch::READABLE) {
+ $self->add_read($watch->get_fileno, $watch, "handle", [&DBus::Watch::READABLE], $watch->is_enabled);
+ }
+ if ($flags & &DBus::Watch::WRITABLE) {
+ $self->add_write($watch->get_fileno, $watch, "handle", [&DBus::Watch::WRITABLE], $watch->is_enabled);
+ }
+ $self->add_exception($watch->get_fileno, $watch, "handle", [&DBus::Watch::ERROR], $watch->is_enabled);
+}
+
+sub _manage_off {
+ my $self = shift;
+ my $watch = shift;
+ my $flags = $watch->get_flags;
+
+ if ($flags & &DBus::Watch::READABLE) {
+ $self->remove_read($watch->get_fileno);
+ }
+ if ($flags & &DBus::Watch::WRITABLE) {
+ $self->remove_write($watch->get_fileno);
+ }
+ $self->remove_exception($watch->get_fileno);
+}
+
+sub _manage_state {
+ my $self = shift;
+ my $watch = shift;
+ my $flags = $watch->get_flags;
+
+ if ($flags & &DBus::Watch::READABLE) {
+ $self->toggle_read($watch->get_fileno, $watch->is_enabled);
+ }
+ if ($flags & &DBus::Watch::WRITABLE) {
+ $self->toggle_write($watch->get_fileno, $watch->is_enabled);
+ }
+ $self->toggle_exception($watch->get_fileno, $watch->is_enabled);
+}
+
+
+sub run {
+ my $self = shift;
+
+ while ($self->step) {};
+}
+
+sub step {
+ my $self = shift;
+
+ my ($ri, $ric) = $self->_bits("read");
+ my ($wi, $wic) = $self->_bits("write");
+ my ($ei, $eic) = $self->_bits("exception");
+ my ($ro, $wo, $eo);
+
+ print "$ric $wic $eic\n";
+
+ if (!$ric && !$wic && !$eic) {
+ print "No handles to listen on. Exiting\n";
+ return 0;
+ }
+
+ my ($n, $timeleft) = select($ro=$ri,$wo=$wi,$eo=$ei, undef);
+
+ if ($n) {
+ $self->_dispatch("read", $ro);
+ $self->_dispatch("write", $wo);
+ $self->_dispatch("error", $eo);
+ }
+
+ return 1;
+}
+
+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 _dispatch {
+ my $self = shift;
+ my $type = shift;
+ my $vec = shift;
+ 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};
+ my $object = $rec->{object};
+ my $code = $rec->{code};
+ my $args = $rec->{args};
+
+ print "Dispatch $type on $fd to $object $code ", join(',', @{$args}), "\n";
+
+ $object->$code(@{$args});
+ }
+ }
+}
+
+
+sub add_read {
+ my $self = shift;
+ $self->_add("read", @_);
+}
+
+sub add_write {
+ my $self = shift;
+ $self->_add("write", @_);
+}
+
+sub add_exception {
+ my $self = shift;
+ $self->_add("exception", @_);
+}
+
+sub _add {
+ my $self = shift;
+ my $type = shift;
+ my $fd = shift;
+ my $obj = shift;
+ my $code = shift;
+ my $args = shift;
+ my $enabled = shift;
+
+ $self->{fds}->{$type}->{$fd} = {
+ object => $obj,
+ code => $code,
+ args => $args,
+ enabled => $enabled
+ };
+}
+
+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;
+
+ delete $self->{fds}->{$type}->{$fd};
+}
+
+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;
+__END__
diff --git a/lib/DBus/Server.pm b/lib/DBus/Server.pm
new file mode 100644
index 0000000..2f6a6f5
--- /dev/null
+++ b/lib/DBus/Server.pm
@@ -0,0 +1,132 @@
+=pod
+
+=head1 NAME
+
+DBus::Connection - A connection between client and server
+
+=head1 SYNOPSIS
+
+Creating a server and accepting client connections
+
+ use DBus::Server;
+
+ my $server = DBus::Server->new(address => "unix:path=/path/to/socket");
+
+ $server->connection_callback(&new_connection);
+
+ sub new_connection {
+ my $connection = shift;
+
+ .. work with new connection...
+ }
+
+=head1 DESCRIPTION
+
+A server for receiving connection from client programs
+
+=cut
+
+package DBus::Server;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+use DBus::Connection;
+
+our $VERSION = '0.0.1';
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+ my $self = {};
+
+ $self->{address} = exists $params{address} ? $params{address} : confess "address parameter is required";
+ $self->{server} = DBus::Server::_open($self->{address});
+
+ bless $self, $class;
+
+ $self->{_callback} = sub {
+ my $server = shift;
+ my $rawcon = shift;
+ my $con = DBus::Connection->new(connection => $rawcon);
+
+ if ($server->{connection_callback}) {
+ &{$server->{connection_callback}}($server, $con);
+ }
+ };
+
+ return $self;
+}
+
+
+sub is_connected {
+ my $self = shift;
+
+ return $self->{server}->dbus_server_get_is_connected();
+}
+
+
+sub disconnect {
+ my $self = shift;
+
+ return $self->{server}->dbus_server_disconnect();
+}
+
+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($self);
+}
+
+sub set_connection_callback {
+ my $self = shift;
+ my $callback = shift;
+
+ $self->{connection_callback} = $callback;
+ print("callback $self $callback\n");
+ $self->{server}->_set_connection_callback($self);
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ print "DESTROy $self $self->{server}\n";
+ if ($self->{server}->dbus_server_get_is_connected()) {
+ $self->{server}->dbus_server_disconnect();
+ }
+ $self->{server}->dbus_server_unref();
+}
+
+
+1;
+
+
+=pod
+
+=head1 SEE ALSO
+
+L<DBus::Connection>, L<DBus::Bus>, L<DBus::Message::Signal>, L<DBus::Message::MethodCall>, L<DBus::Message::MethodReturn>, L<DBus::Message::Error>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan at berrange.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004 by Daniel Berrange
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBus/Watch.pm b/lib/DBus/Watch.pm
new file mode 100644
index 0000000..27db551
--- /dev/null
+++ b/lib/DBus/Watch.pm
@@ -0,0 +1,32 @@
+package DBus::Watch;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use DBus;
+
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function.
+
+ my $constname;
+ our $AUTOLOAD;
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+
+ croak "&DBus::Watch::constant not defined" if $constname eq '_constant';
+
+ if (!exists $DBus::Watch::_constants{$constname}) {
+ croak "no such constant \$DBus::Watch::$constname";
+ }
+
+ {
+ no strict 'refs';
+ *$AUTOLOAD = sub { $DBus::Watch::_constants{$constname} };
+ }
+ goto &$AUTOLOAD;
+}
+
+1;
+__END__
diff --git a/t/1.t b/t/1.t
new file mode 100644
index 0000000..e9f79bc
--- /dev/null
+++ b/t/1.t
@@ -0,0 +1,52 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl 1.t'
+
+#########################
+
+# change 'tests => 6' to 'tests => last_test_to_print';
+
+use Test::More tests => 6;
+BEGIN {
+ use_ok('DBus::Watch');
+ use_ok('DBus::Message');
+ use_ok('DBus::Bus');
+ };
+
+
+my $fail = 0;
+foreach my $constname (qw(
+ SYSTEM SESSION ACTIVATION)) {
+ next if (eval "my \$a = &DBus::Bus::$constname; 1");
+ print "# fail: $@";
+ $fail = 1;
+}
+ok( $fail == 0 , 'DBus::Bus Constants' );
+
+$fail = 0;
+foreach my $constname (qw(
+ TYPE_ARRAY TYPE_BOOLEAN
+ TYPE_BYTE TYPE_CUSTOM TYPE_DICT
+ TYPE_DOUBLE TYPE_INT32 TYPE_INT64
+ TYPE_INVALID TYPE_NIL TYPE_OBJECT_PATH
+ TYPE_STRING TYPE_UINT32 TYPE_UINT64)) {
+ next if (eval "my \$a = &DBus::Message::$constname; 1");
+ print "# fail: $@";
+ $fail = 1;
+}
+ok( $fail == 0 , 'DBus::Message Constants' );
+
+$fail = 0;
+foreach my $constname (qw(
+ READABLE WRITABLE
+ ERROR HANGUP)) {
+ next if (eval "my \$a = &DBus::Watch::$constname; 1");
+ print "# fail: $@";
+ $fail = 1;
+}
+
+ok( $fail == 0 , 'DBus::Watch Constants' );
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
diff --git a/t/2.t b/t/2.t
new file mode 100644
index 0000000..f2e106a
--- /dev/null
+++ b/t/2.t
@@ -0,0 +1,24 @@
+
+use Test::More tests => 4;
+BEGIN { use_ok('DBus::Connection');
+ use_ok('DBus::Reactor');
+ };
+
+$ENV{DBUS_VERBOSE} = 1;
+
+#my $con = DBus::Connection->new(address => "unix:path=/var/run/dbus/system_bus_socket");
+my $con = DBus::Connection->new(address => "unix:path=/tmp/dbus-perl-test");
+
+ok($con, "Connection");
+
+ok($con->is_connected, "Is Connected");
+
+my $reactor = DBus::Reactor->new();
+$reactor->manage($con);
+ok(1, "watches");
+
+$reactor->run();
+
+$con->disconnect;
+
+ok(!$con->is_connected, "Not Connected");
diff --git a/t/3.t b/t/3.t
new file mode 100644
index 0000000..ee47541
--- /dev/null
+++ b/t/3.t
@@ -0,0 +1,24 @@
+use Test::More tests => 5;
+BEGIN {
+ use_ok('DBus');
+ use_ok('DBus::Bus');
+ use_ok('DBus::Reactor');
+ };
+
+
+my $con = DBus::Bus->new(type => &DBus::Bus::SYSTEM);
+
+ok($con, "Connection");
+
+ok($con->is_connected, "Is Connected");
+
+my $reactor = DBus::Reactor->new();
+$reactor->manage($con);
+ok(1, "watches");
+
+$reactor->run();
+
+$con->disconnect;
+
+ok(!$con->is_connected, "Not Connected");
+
diff --git a/t/4.t b/t/4.t
new file mode 100644
index 0000000..1f05129
--- /dev/null
+++ b/t/4.t
@@ -0,0 +1,21 @@
+use Test::More tests => 7;
+BEGIN {
+ use_ok('DBus::Bus');
+ use_ok('DBus::Message::Signal');
+ use_ok('DBus::Message::MethodCall');
+ };
+
+
+my $con = DBus::Bus->new(type => &DBus::Bus::SYSTEM);
+
+ok($con, "Connection");
+
+my $signal = DBus::Message::Signal->new(path => "foo/bar", interface => "bar.wizz", name => "wizz");
+
+my $serial = $con->send($signal);
+
+ok($serial, "serial");
+
+$con->flush();
+
+ok(1, "flush");
diff --git a/t/5.t b/t/5.t
new file mode 100644
index 0000000..73005d2
--- /dev/null
+++ b/t/5.t
@@ -0,0 +1,39 @@
+use Test::More tests => 5;
+BEGIN { use_ok('DBus::Server'); use_ok('DBus'); use_ok('DBus::Reactor') };
+
+$ENV{DBUS_VERBOSE} = 1;
+
+my $con = DBus::Server->new(address => "unix:path=/tmp/dbus-perl-test");
+
+ok($con, "Server");
+
+ok($con->is_connected, "Is Connected");
+
+$con->set_connection_callback(\&new_con);
+
+my $reactor = DBus::Reactor->new();
+
+$reactor->manage($con);
+
+ok(1, "watches");
+
+$reactor->run();
+
+
+$con->disconnect;
+
+ok(!$con->is_connected, "Not Connected");
+
+my %cons;
+
+sub new_con {
+ my $server = shift;
+ my $connection = shift;
+
+ $cons{$connection} = $connection;
+
+ $reactor->manage($connection);
+
+ print "Got $server $connection\n";
+}
+
diff --git a/t/6.t b/t/6.t
new file mode 100644
index 0000000..2d6a667
--- /dev/null
+++ b/t/6.t
@@ -0,0 +1,58 @@
+use Test::More tests => 5;
+BEGIN {
+ use_ok('DBus');
+ use_ok('DBus::Connection');
+ use_ok('DBus::Message::Signal');
+ use_ok('DBus::Reactor');
+ };
+
+
+my $con = DBus::Connection->new(address => "unix:path=/tmp/dbus-perl-test");
+#my $con = DBus::Bus->new(type => DBus::DBUS_BUS_SYSTEM);
+
+ok($con, "Connection");
+
+ok($con->is_connected, "Is Connected");
+
+my $msg = DBus::Message::Signal->new(path => "/foo/bar/Wizz",
+ interface => "com.blah.Example",
+ name => "Eeek");
+
+my $iter = $msg->iterator();
+$iter->append_boolean(1);
+$iter->append_byte(43);
+$iter->append_int32(123);
+$iter->append_uint32(456);
+$iter->append_int64(12345645645);
+$iter->append_uint64(12312312312);
+$iter->append_string("Hello world");
+$iter->append_double(1.424141);
+
+$iter = $msg->iterator();
+ok($iter->get_boolean() == 1, "boolean");
+ok($iter->next(), "next");
+ok($iter->get_byte() == 43, "byte");
+ok($iter->next(), "next");
+ok($iter->get_int32() == 123, "int32");
+ok($iter->next(), "next");
+ok($iter->get_uint32() == 456, "uint32");
+ok($iter->next(), "next");
+ok($iter->get_int64() == 12345645645, "int64");
+ok($iter->next(), "next");
+ok($iter->get_uint64() == 12312312312, "uint64");
+ok($iter->next(), "next");
+ok($iter->get_string() eq "Hello world", "string");
+ok($iter->next(), "next");
+ok($iter->get_double() == 1.424141, "double");
+
+my $reactor = DBus::Reactor->new();
+$reactor->manage($con);
+ok(1, "watches");
+
+$con->send($msg);
+
+$reactor->run();
+
+$con->disconnect;
+
+ok(!$con->is_connected, "Not Connected");
diff --git a/typemap b/typemap
new file mode 100644
index 0000000..e2428e4
--- /dev/null
+++ b/typemap
@@ -0,0 +1,78 @@
+TYPEMAP
+DBusConnection* O_OBJECT_connection
+DBusServer* O_OBJECT_server
+DBusMessage* O_OBJECT_message
+DBusWatch* O_OBJECT_watch
+DBusMessageIter* O_OBJECT_messageiter
+DBusBusType T_IV
+dbus_bool_t T_IV
+dbus_int32_t T_IV
+dbus_uint32_t T_IV
+dbus_int64_t T_IV
+dbus_uint64_t T_IV
+
+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, "DBus::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, "DBus::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, "DBus::C::Message", (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, "DBus::C::Watch", (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, "DBus::C::MessageIter", (void*)$var );
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dbus-perl.git
More information about the Pkg-perl-cvs-commits
mailing list