[libnet-dbus-perl] 209/335: Added support for async reply callbacks

[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 4d96893e1f935b978b4637b484f1e95a27e665d9
Author: Daniel P. Berrange <berrange at redhat.com>
Date:   Mon Jul 3 09:31:32 2006 -0400

    Added support for async reply callbacks
---
 CHANGES                             |  4 ++++
 DBus.xs                             | 41 ++++++++++++++++++++++++++++++++++
 examples/example-client-async.pl    | 41 ++++++++++++++++++++++++++++++++++
 examples/example-service-async.pl   | 44 +++++++++++++++++++++++++++++++++++++
 lib/Net/DBus/ASyncReply.pm          | 19 ++++++++++++++++
 lib/Net/DBus/Binding/PendingCall.pm | 15 +++++++++++++
 6 files changed, 164 insertions(+)

diff --git a/CHANGES b/CHANGES
index ba745ed..6288b75 100644
--- a/CHANGES
+++ b/CHANGES
@@ -22,6 +22,10 @@ Changes since 0.33.2
  - Change re-distribution license from GPL, to GPL / Perl Artistic,
    matching the terms of Perl itself.
 
+ - Add support for registering a callback on Net::DBus::ASyncReply
+   objects to allow notification of completion for asynchronous
+   method calls
+
 Changes since 0.33.1
 
  - Fixed handling of variants in introspection data
diff --git a/DBus.xs b/DBus.xs
index 912112a..9da25af 100644
--- a/DBus.xs
+++ b/DBus.xs
@@ -35,6 +35,7 @@
    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) {
@@ -268,11 +269,41 @@ if (0) {
 }
 
 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);
@@ -411,6 +442,7 @@ BOOT:
 
 	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);
     }
 
 
@@ -1016,6 +1048,15 @@ 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:
diff --git a/examples/example-client-async.pl b/examples/example-client-async.pl
new file mode 100644
index 0000000..cbca6e2
--- /dev/null
+++ b/examples/example-client-async.pl
@@ -0,0 +1,41 @@
+#/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Net::DBus;
+use Net::DBus::Reactor;
+use Net::DBus::Callback;
+use Net::DBus::Annotation qw(:call);
+
+my $bus = Net::DBus->session();
+
+my $service = $bus->get_service("org.designfu.SampleService");
+my $object = $service->get_object("/SomeObject");
+
+print "Doing async call\n";
+my $reply = $object->HelloWorld(dbus_call_async, "Hello from example-client.pl!");
+
+my $r = Net::DBus::Reactor->main;
+
+sub all_done {
+    my $reply = shift;
+    my $list = $reply->get_result;
+    print "[", join(", ", map { "'$_'" } @{$list}), "]\n";
+
+    $r->shutdown;
+}
+
+print "Setting notify\n";
+$reply->set_notify(\&all_done);
+
+sub tick {
+    print "Tick-tock\n";
+}
+
+
+print "Adding timer\n";
+$r->add_timeout(500, Net::DBus::Callback->new(method => \&tick));
+
+print "Entering main loop\n";
+$r->run;
diff --git a/examples/example-service-async.pl b/examples/example-service-async.pl
new file mode 100644
index 0000000..bb29f9d
--- /dev/null
+++ b/examples/example-service-async.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Carp qw(confess cluck);
+use Net::DBus;
+use Net::DBus::Service;
+use Net::DBus::Reactor;
+
+#...  continued at botom
+
+
+package SomeObject;
+
+use base qw(Net::DBus::Object);
+use Net::DBus::Exporter qw(org.designfu.SampleInterface);
+
+sub new {
+    my $class = shift;
+    my $service = shift;
+    my $self = $class->SUPER::new($service, "/SomeObject");
+    bless $self, $class;
+
+    return $self;
+}
+
+dbus_method("HelloWorld", ["string"], [["array", "string"]]);
+sub HelloWorld {
+    my $self = shift;
+    my $message = shift;
+    print "Do hello world\n";
+    print $message, "\n";
+    sleep 10;
+    return ["Hello", " from example-service-async.pl"];
+}
+
+package main;
+
+my $bus = Net::DBus->session();
+my $service = $bus->export_service("org.designfu.SampleService");
+my $object = SomeObject->new($service);
+
+Net::DBus::Reactor->main->run();
diff --git a/lib/Net/DBus/ASyncReply.pm b/lib/Net/DBus/ASyncReply.pm
index 1e72131..94f6f60 100644
--- a/lib/Net/DBus/ASyncReply.pm
+++ b/lib/Net/DBus/ASyncReply.pm
@@ -119,6 +119,25 @@ sub is_ready {
 }
 
 
+=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.
diff --git a/lib/Net/DBus/Binding/PendingCall.pm b/lib/Net/DBus/Binding/PendingCall.pm
index 36aff92..dfb1f0f 100644
--- a/lib/Net/DBus/Binding/PendingCall.pm
+++ b/lib/Net/DBus/Binding/PendingCall.pm
@@ -142,6 +142,21 @@ sub get_reply {
     }
 }
 
+=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

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