[libnet-dbus-perl] 195/335: Added binding for DBusPendingCall objects
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:54 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 3c306f51d155f67ec970d2de1c4332dffe470bd2
Author: Daniel P. Berrange <berrange at redhat.com>
Date: Sat Jun 3 16:12:44 2006 -0400
Added binding for DBusPendingCall objects
---
DBus.xs | 45 ++++++++++
lib/Net/DBus/Binding/Connection.pm | 25 +++++-
lib/Net/DBus/Binding/PendingCall.pm | 166 ++++++++++++++++++++++++++++++++++++
3 files changed, 235 insertions(+), 1 deletion(-)
diff --git a/DBus.xs b/DBus.xs
index 053da4d..db449a1 100644
--- a/DBus.xs
+++ b/DBus.xs
@@ -500,6 +500,25 @@ _send_with_reply_and_block(con, msg, timeout)
OUTPUT:
RETVAL
+
+DBusPendingCall *
+_send_with_reply(con, msg, timeout)
+ DBusConnection *con;
+ DBusMessage *msg;
+ int timeout;
+ PREINIT:
+ DBusPendingCall *reply;
+ CODE:
+ if (!dbus_connection_send_with_reply(con, msg, &reply, timeout)) {
+ croak("not enough memory to send message");
+ }
+ PD_DEBUG("Create pending call %p\n", reply);
+ // XXX needed ?
+ //dbus_pending_call_ref(reply);
+ RETVAL = reply;
+ OUTPUT:
+ RETVAL
+
DBusMessage *
dbus_connection_borrow_message(con)
DBusConnection *con;
@@ -978,6 +997,32 @@ _create(replyto, name, message)
OUTPUT:
RETVAL
+MODULE = Net::DBus::Binding::C::PendingCall PACKAGE = Net::DBus::Binding::C::PendingCall
+
+PROTOTYPES: ENABLE
+
+DBusMessage *
+dbus_pending_call_steal_reply(call)
+ DBusPendingCall *call;
+
+void
+dbus_pending_call_block(call)
+ DBusPendingCall *call;
+
+dbus_bool_t
+dbus_pending_call_get_completed(call)
+ DBusPendingCall *call;
+
+void
+dbus_pending_call_cancel(call)
+ DBusPendingCall *call;
+
+void
+DESTROY (call)
+ DBusPendingCall *call;
+ CODE:
+ PD_DEBUG("Unrefing pending call %p", call);
+ dbus_pending_call_unref(call);
MODULE = Net::DBus::Binding::C::Watch PACKAGE = Net::DBus::Binding::C::Watch
diff --git a/lib/Net/DBus/Binding/Connection.pm b/lib/Net/DBus/Binding/Connection.pm
index fc09f8c..c345622 100644
--- a/lib/Net/DBus/Binding/Connection.pm
+++ b/lib/Net/DBus/Binding/Connection.pm
@@ -78,6 +78,7 @@ use Carp;
use Net::DBus;
use Net::DBus::Binding::Message::MethodReturn;
+use Net::DBus::Binding::PendingCall;
=item my $con = Net::DBus::Binding::Connection->new(address => "unix:path=/path/to/socket");
@@ -195,7 +196,7 @@ sub send_with_reply_and_block {
my $self = shift;
my $msg = shift;
my $timeout = shift;
-
+
my $reply = $self->{connection}->_send_with_reply_and_block($msg->{message}, $timeout);
my $type = $reply->dbus_message_get_type;
@@ -211,6 +212,28 @@ sub send_with_reply_and_block {
}
+=item my $pending_call = $con->send_with_reply($msg, $timeout);
+
+Queues a message up for sending to the remote host
+and returns immediately providing a reference to a
+C<Net::DBus::Binding::PendingCall> object. This object
+can be used to wait / watch for a reply. This allows
+methods to be processed asynchronously.
+
+=cut
+
+sub send_with_reply {
+ my $self = shift;
+ my $msg = shift;
+ my $timeout = shift;
+
+ my $reply = $self->{connection}->_send_with_reply($msg->{message}, $timeout);
+
+ return Net::DBus::Binding::PendingCall->new(method_call => $msg,
+ pending_call => $reply);
+}
+
+
=item $con->dispatch;
Dispatches any pending messages in the incoming queue
diff --git a/lib/Net/DBus/Binding/PendingCall.pm b/lib/Net/DBus/Binding/PendingCall.pm
new file mode 100644
index 0000000..27a3759
--- /dev/null
+++ b/lib/Net/DBus/Binding/PendingCall.pm
@@ -0,0 +1,166 @@
+# -*- perl -*-
+#
+# Copyright (C) 2006 Daniel P. Berrange
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# $Id: PendingCall.pm,v 1.8 2006/01/27 15:34:24 dan Exp $
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::PendingCall - A handler for pending method replies
+
+=head1 SYNOPSIS
+
+ my $call = Net::DBus::Binding::PendingCall->new(method_call => $call,
+ pending_call => $reply);
+
+ # Wait for completion
+ $call->block;
+
+ # And get the reply message
+ my $msg = $call->get_reply;
+
+=head1 DESCRIPTION
+
+This object is used when it is neccessary to make asynchronous method
+calls. It provides the means to be notified when the reply is finally
+received.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Net::DBus::Binding::PendingCall;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+use Net::DBus;
+use Net::DBus::Binding::Message::MethodReturn;
+use Net::DBus::Binding::Message::Error;
+
+=item my $call = Net::DBus::Binding::PendingCall->new(method_call => $method_call,
+ pending_call => $pending_call);
+
+Creates a new pending call object, with the C<method_call> parameter
+being a reference to the C<Net::DBus::Binding::Message::MethodCall>
+object whose reply is being waiting for. The C<pending_call> parameter
+is a reference to the raw C pending call object.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+ my $self = {};
+
+ $self->{method_call} = exists $params{method_call} ? $params{method_call} : die "method_call parameter is required";
+ $self->{pending_call} = exists $params{pending_call} ? $params{pending_call} : die "pending_call parameter is required";
+
+ bless $self, $class;
+
+ return $self;
+}
+
+=item $call->cancel
+
+Cancel the pending call, causing any reply that is later received
+to be discarded.
+
+=cut
+
+sub cancel {
+ my $self = shift;
+
+ $self->{pending_call}->dbus_pending_call_cancel();
+}
+
+
+=item my $boolean = $call->get_completed
+
+Returns a true value if the pending call has received its reply,
+or a timeout has occurred.
+
+=cut
+
+sub get_completed {
+ my $self = shift;
+
+ $self->{pending_call}->dbus_pending_call_get_completed();
+}
+
+=item $call->block
+
+Block the caller until the reply is recieved or a timeout
+occurrs.
+
+=cut
+
+sub block {
+ my $self = shift;
+
+ $self->{pending_call}->dbus_pending_call_block();
+}
+
+=item my $msg = $call->get_reply;
+
+Retrieves the C<Net::DBus::Binding::Message> object associated
+with the complete call.
+
+=cut
+
+sub get_reply {
+ my $self = shift;
+
+ my $reply = $self->{pending_call}->dbus_pending_call_steal_reply();
+ my $type = $reply->dbus_message_get_type;
+ if ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_ERROR) {
+ return Net::DBus::Binding::Message::Error->new(replyto => $self->{method_call},
+ message => $reply);
+ } elsif ($type == &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN) {
+ return Net::DBus::Binding::Message::MethodReturn->new(call => $self->{method_call},
+ message => $reply);
+ } else {
+ confess "unknown method reply type $type";
+ }
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus::Binding::Connection>, L<Net::DBus::Binding::Message>, L<Net::DBus::ASyncReply>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan at berrange.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2006 by Daniel Berrange
+
+=cut
--
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