[libnet-dbus-perl] 290/335: Automatically track unique<->bus names for signal handlers across restarts

[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 5cc1854fa564317471c59dfc4df167dcc8366ccd
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Thu Jun 30 21:44:28 2011 +0100

    Automatically track unique<->bus names for signal handlers across restarts
---
 lib/Net/DBus.pm              | 109 +++++++++++++++++++++----------------------
 lib/Net/DBus/RemoteObject.pm |   4 +-
 2 files changed, 56 insertions(+), 57 deletions(-)

diff --git a/lib/Net/DBus.pm b/lib/Net/DBus.pm
index a0aa161..16a8029 100644
--- a/lib/Net/DBus.pm
+++ b/lib/Net/DBus.pm
@@ -246,6 +246,7 @@ sub _new {
 
     $self->{connection} = shift;
     $self->{signals} = [];
+    # Map well known names to RemoteService objects
     $self->{services} = {};
 
     my %params = @_;
@@ -262,7 +263,15 @@ sub _new {
 
     $self->get_connection->add_filter(sub { return $self->_signal_func(@_); });
 
-    $self->{bus} = Net::DBus::RemoteService->new($self, "org.freedesktop.DBus", "org.freedesktop.DBus");
+    $self->{bus} = $self->{services}->{"org.freedesktop.DBus"} =
+	Net::DBus::RemoteService->new($self, "org.freedesktop.DBus", "org.freedesktop.DBus");
+    $self->get_bus_object()->connect_to_signal('NameOwnerChanged', sub {
+	my ($svc, $old, $new) = @_;
+	# Slightly evil poking into the private 'owner_name' field here
+	if (exists $self->{services}->{$svc}) {
+	    $self->{services}->{$svc}->{owner_name} = $new;
+	}
+    });
 
     return $self;
 }
@@ -298,19 +307,18 @@ sub get_service {
 	return $self->{bus};
     }
 
-    my $owner = $name;
-    if ($owner !~ /^:/) {
-	$owner = $self->get_service_owner($name);
-	if (!$owner) {
-	    $self->get_bus_object->StartServiceByName($name, 0);
+    if (!exists $self->{services}->{$name}) {
+	my $owner = $name;
+	if ($owner !~ /^:/) {
 	    $owner = $self->get_service_owner($name);
+	    if (!defined $owner) {
+		$self->get_bus_object->StartServiceByName($name, 0);
+		$owner = $self->get_service_owner($name);
+	    }
 	}
+	$self->{services}->{$name} = Net::DBus::RemoteService->new($self, $owner, $name);
     }
-
-    unless (exists $self->{services}->{$owner}) {
-	$self->{services}->{$owner} = Net::DBus::RemoteService->new($self, $owner, $name);
-    }
-    return $self->{services}->{$owner};
+    return $self->{services}->{$name};
 }
 
 =item my $service = $bus->export_service($name);
@@ -393,8 +401,12 @@ sub _add_signal_receiver {
     my $path = shift;
 
     my $rule = $self->_match_rule($signal_name, $interface, $service, $path);
-
-    push @{$self->{signals}}, [$receiver, $rule, $signal_name, $interface, $service, $path];
+    push @{$self->{signals}}, { cb => $receiver,
+				rule => $rule,
+				signal_name => $signal_name,
+				interface => $interface,
+				service => $service,
+				path => $path };
     $self->{connection}->add_match($rule);
 }
 
@@ -407,12 +419,10 @@ sub _remove_signal_receiver {
     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) {
+	if ($_->{cb} eq $receiver &&
+	    $_->{rule} eq $rule) {
 	    $self->{connection}->remove_match($rule);
 	} else {
 	    push @signals, $_;
@@ -430,60 +440,50 @@ sub _match_rule {
     my $path = shift;
 
     my $rule = "type='signal'";
-    if ($interface) {
+    if (defined $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) {
+    if (defined $path) {
 	$rule .= ",path='$path'";
     }
-    if ($signal_name) {
+    if (defined $service) {
+	$rule .= ",sender='$service'";
+    }
+    if (defined $signal_name) {
 	$rule .= ",member='$signal_name'";
     }
+    print "$rule\n";
     return $rule;
 }
 
 
-sub _rule_matches {
+sub _handler_matches {
     my $self = shift;
-    my $rule = shift;
-    my $member = shift;
+    my $handler = shift;
+    my $signal_name = 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) {
+    if (defined $handler->{signal_name} &&
+	$handler->{signal_name} ne $signal_name) {
 	return 0;
     }
-    if (exists $bits{interface} &&
-	$bits{interface} ne $interface) {
+    if (defined $handler->{interface} &&
+	$handler->{interface} ne $interface) {
 	return 0;
     }
-    if (exists $bits{sender} &&
-	$bits{sender} ne $sender) {
+    if (defined $handler->{path} &&
+	$handler->{path} ne $path) {
 	return 0;
     }
-    if (exists $bits{path} &&
-	$bits{path} ne $path) {
-	return 0;
+
+    if (defined $handler->{service}) {
+	my $owner = $self->{services}->{$handler->{service}};
+	return 0 unless defined $owner;
+	return 0 unless $owner->get_owner_name eq $sender;
     }
+
     return 1;
 }
 
@@ -497,13 +497,12 @@ sub _signal_func {
     my $interface = $message->get_interface;
     my $sender = $message->get_sender;
     my $path = $message->get_path;
-    my $member = $message->get_member;
-
+    my $signal_name = $message->get_member;
+    print "Sender $sender\n";
     my $handled = 0;
-    foreach my $handler (grep { defined $_->[1] &&
-				$self->_rule_matches($_->[1], $member, $interface, $sender, $path) }
-			 @{$self->{signals}}) {
-	my $callback = $handler->[0];
+    foreach my $handler (@{$self->{signals}}) {
+	next unless $self->_handler_matches($handler, $signal_name, $interface, $sender, $path);
+	my $callback = $handler->{cb};
 	&$callback($message);
 	$handled = 1;
     }
diff --git a/lib/Net/DBus/RemoteObject.pm b/lib/Net/DBus/RemoteObject.pm
index fcf0052..bd7f153 100644
--- a/lib/Net/DBus/RemoteObject.pm
+++ b/lib/Net/DBus/RemoteObject.pm
@@ -266,7 +266,7 @@ sub connect_to_signal {
 	    _add_signal_receiver($cb,
 				 $name,
 				 $interface,
-				 $self->{service}->get_owner_name(),
+				 $self->{service}->get_service_name(),
 				 $self->{object_path});
     }
     my $sigid = ++$self->{signal_id};
@@ -324,7 +324,7 @@ sub disconnect_from_signal {
 	    _remove_signal_receiver($self->{signal_handlers}->{$name}->{cb},
 				    $name,
 				    $interface,
-				    $self->{service}->get_owner_name(),
+				    $self->{service}->get_service_name(),
 				    $self->{object_path});
 	delete $self->{signal_handlers}->{$name};
     }

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