[libnet-dbus-perl] 71/335: Add connect_to_signal to allow connecting to locally exported objects, although we really ought to short circuit the emit_signal method i reckon

[Intrigeri]

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 181602dfd2f7cfb6754021b1fd3ff63564dc149f
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Mon Aug 15 18:12:39 2005 +0000

    Add connect_to_signal to allow connecting to locally exported objects, although we really ought to short circuit the emit_signal method i reckon
---
 lib/Net/DBus/Object.pm | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/lib/Net/DBus/Object.pm b/lib/Net/DBus/Object.pm
index 2e858e1..54e1d61 100644
--- a/lib/Net/DBus/Object.pm
+++ b/lib/Net/DBus/Object.pm
@@ -203,6 +203,40 @@ sub emit_signal {
     $self->emit_signal_in($name, $interfaces[0], @_);
 }   
 
+# XXX dont duplicate me from RemoteObject
+sub connect_to_signal {
+    my $self = shift;
+    my $name = shift;
+    my $code = shift;
+    my $lazy_binding = shift;
+
+    my $ins = $self->_introspector;
+    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";
+    }
+
+    $self->get_service->
+	get_bus()->
+	add_signal_receiver(sub {
+	    my $signal = shift;
+	    my $ins = $self->_introspector;
+	    my @params = $ins->decode($signal, "signals", $signal->get_member, "params");
+	    &$code(@params);
+	},
+			    $name,
+			    $interfaces[0],
+			    $lazy_binding ? undef : $self->get_service->get_service_name(),
+			    $self->get_object_path);
+}
+
+
 sub _dispatch {
     my $self = shift;
     my $connection = shift;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dbus-perl.git