[libnet-dbus-perl] 29/335: Tied up signal handling

[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 ea186cf65496b5ed33e222c87e4e28771deaef75
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Tue Nov 23 23:26:31 2004 +0000

    Tied up signal handling
---
 lib/Net/DBus/Reactor.pm       | 27 +++++++++++++++++++--------
 lib/Net/DBus/RemoteObject.pm  | 34 ++++++++++++++++++++++++++--------
 lib/Net/DBus/RemoteService.pm | 21 ++++++++++++++++-----
 lib/Net/DBus/Service.pm       |  6 +++++-
 4 files changed, 66 insertions(+), 22 deletions(-)

diff --git a/lib/Net/DBus/Reactor.pm b/lib/Net/DBus/Reactor.pm
index 183ee71..17b2f5f 100644
--- a/lib/Net/DBus/Reactor.pm
+++ b/lib/Net/DBus/Reactor.pm
@@ -177,8 +177,8 @@ sub manage {
 	    
 	    my $key = $self->add_timeout($timeout->get_interval,
 					 Net::DBus::Callback->new(object => $timeout,
-							     method => "handle",
-							     args => []),
+								  method => "handle",
+								  args => []),
 					 $timeout->is_enabled);
 	    $timeout->set_data($key);
 	}, sub {
@@ -200,8 +200,14 @@ sub manage {
     
     if ($object->can("dispatch")) {
 	$self->add_hook(Net::DBus::Callback->new(object => $object, 
-					    method => "dispatch", 
-					    args => []), 
+						 method => "dispatch", 
+						 args => []), 
+			1);
+    }
+    if ($object->can("flush")) {
+	$self->add_hook(Net::DBus::Callback->new(object => $object, 
+						 method => "flush", 
+						 args => []), 
 			1);
     }
 }
@@ -326,17 +332,23 @@ sub step {
 	return;
     }
     
+    my @callbacks = $self->_dispatch_hook();
+    
+    foreach my $callback (@callbacks) {
+	$callback->invoke;
+    }
+    
     my ($ro, $wo, $eo);
     my $n = select($ro=$ri,$wo=$wi,$eo=$ei, (defined $timeout ? ($timeout ? $timeout/1000 : 0) : undef));
     
-    my @callbacks;
+    @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();
+    #push @callbacks, $self->_dispatch_hook();
     
     foreach my $callback (@callbacks) {
 	$callback->invoke;
@@ -432,7 +444,6 @@ sub _dispatch_hook {
     my @callbacks;
     foreach my $hook (@{$self->{hooks}}) {
 	next unless $hook->{enabled};
-
 	push @callbacks, $hook->{callback};
     }
     return @callbacks;
@@ -594,7 +605,7 @@ sub add_hook {
 	$key = $i unless defined $self->{hooks}->[$i];
     }
     $key = $#{$self->{hooks}}+1 unless defined $key;
-    
+
     $self->{hooks}->[$key] = {
 	callback => $callback,
 	enabled => $enabled
diff --git a/lib/Net/DBus/RemoteObject.pm b/lib/Net/DBus/RemoteObject.pm
index c61c88e..27782f8 100644
--- a/lib/Net/DBus/RemoteObject.pm
+++ b/lib/Net/DBus/RemoteObject.pm
@@ -14,8 +14,7 @@ sub new {
     my $class = shift;
     my $self = {};
 
-    $self->{connection}   = shift;
-    $self->{service_name} = shift;
+    $self->{service} = shift;
     $self->{object_path}  = shift;
     $self->{interface}    = shift;
 
@@ -24,6 +23,20 @@ sub new {
     return $self;
 }
 
+sub connect_to_signal {
+    my $self = shift;
+    my $signal_name = shift;
+    my $code = shift;
+    
+    $self->{service}->
+	get_bus()->
+	add_signal_receiver($code,
+			    $signal_name,
+			    $self->{interface},
+			    $self->{service}->get_service_name(),
+			    $self->{object_path});
+}
+
 sub DESTROY {
     # No op merely to stop AutoLoader trying to
     # call DESTROY on remote object
@@ -34,19 +47,24 @@ sub AUTOLOAD {
     my $sub = $AUTOLOAD;
     
     (my $method = $AUTOLOAD) =~ s/.*:://;
-    my $call = Net::DBus::Binding::Message::MethodCall->new(service_name => $self->{service_name},
-							    object_path => $self->{object_path},
-							    method_name => $method,
-							    interface => $self->{interface});
+    my $call = Net::DBus::Binding::Message::MethodCall->
+	new(service_name => $self->{service}->get_service_name(),
+	    object_path => $self->{object_path},
+	    method_name => $method,
+	    interface => $self->{interface});
 
     my $iter = $call->iterator;
     foreach my $arg (@_) {
 	$iter->append($arg);
     }
     
-    my $reply = $self->{connection}->send_with_reply_and_block($call, 5000);
+    my $reply = $self->{service}->
+	get_bus()->
+	get_connection()->
+	send_with_reply_and_block($call, 5000);
     
-    return $reply->get_args_list;
+    my @reply = $reply->get_args_list;
+    return wantarray ? @reply : $reply[0];
 }
 
 
diff --git a/lib/Net/DBus/RemoteService.pm b/lib/Net/DBus/RemoteService.pm
index 0b65924..e5ab491 100644
--- a/lib/Net/DBus/RemoteService.pm
+++ b/lib/Net/DBus/RemoteService.pm
@@ -14,21 +14,32 @@ sub new {
     my $class = shift;
     my $self = {};
 
-    $self->{connection}   = shift;
-    $self->{service_name}  = shift;
+    $self->{bus} = shift;
+    $self->{service_name} = shift;
 
     bless $self, $class;
 
     return $self;
 }
-   
+
+sub get_bus {
+    my $self = shift;
+
+    return $self->{bus};
+}
+
+
+sub get_service_name {
+    my $self = shift;
+    return $self->{service_name};
+}
+
 sub get_object {
     my $self = shift;
     my $object_path = shift;
     my $interface = shift;
     
-    return Net::DBus::RemoteObject->new($self->{connection}, 
-					$self->{service_name},
+    return Net::DBus::RemoteObject->new($self,
 					$object_path,
 					$interface);
 }
diff --git a/lib/Net/DBus/Service.pm b/lib/Net/DBus/Service.pm
index 8334e96..9de04ec 100644
--- a/lib/Net/DBus/Service.pm
+++ b/lib/Net/DBus/Service.pm
@@ -10,11 +10,15 @@ sub new {
     
     bless $self, $class;
 
-    $self->{bus}->{connection}->acquire_service($self->{service_name});
+    $self->{bus}->get_connection()->acquire_service($self->{service_name});
     
     return $self;
 }
 
+sub get_bus {
+    my $self = shift;
+    return $self->{bus};
+}
 
 sub service_name {
     my $self = shift;

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