[libnet-dbus-perl] 137/335: Make us relaxed about typing for incoming data, to play nicer with other languages

[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 d9c53a7ea26580f9f25bbf9b748412d3bb9d88f4
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Mon Oct 17 21:28:01 2005 +0000

    Make us relaxed about typing for incoming data, to play nicer with other languages
---
 lib/Net/DBus/Binding/Introspector.pm | 15 +++++++++------
 lib/Net/DBus/Binding/Iterator.pm     |  8 ++++++--
 lib/Net/DBus/RemoteObject.pm         |  4 ++--
 3 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/lib/Net/DBus/Binding/Introspector.pm b/lib/Net/DBus/Binding/Introspector.pm
index 882429a..06a9121 100644
--- a/lib/Net/DBus/Binding/Introspector.pm
+++ b/lib/Net/DBus/Binding/Introspector.pm
@@ -16,7 +16,7 @@
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #
-# $Id: Introspector.pm,v 1.9 2005/10/15 13:31:42 dan Exp $
+# $Id: Introspector.pm,v 1.10 2005/10/17 22:28:01 dan Exp $
 
 =pod
 
@@ -697,22 +697,25 @@ sub decode {
 	@{$self->{interfaces}->{$interface}->{$type}->{$name}} :
 	@{$self->{interfaces}->{$interface}->{$type}->{$name}->{$direction}};
 
+    # If there are no types defined, just return the
+    # actual data from the message, assuming the introspection
+    # data was partial.
+    return $message->get_args_list 
+	unless @types;
+
     my $iter = $message->iterator;
     
-    # XXX validate received message against instrospection data!
     my @rawtypes = $self->convert(@types);
-    return () unless @rawtypes;
     my @ret;
     do {
-	my $rawtype = shift @rawtypes;
 	my $type = shift @types;
-
+	my $rawtype = shift @rawtypes;
+	
 	if (exists $magic_type_map{$type}) {
 	    push @ret, &$rawtype($message);
 	} else {
 	    push @ret, $iter->get($rawtype);
 	}
     } while ($iter->next);
-
     return @ret;
 }
diff --git a/lib/Net/DBus/Binding/Iterator.pm b/lib/Net/DBus/Binding/Iterator.pm
index 90cbca9..c6d96dd 100644
--- a/lib/Net/DBus/Binding/Iterator.pm
+++ b/lib/Net/DBus/Binding/Iterator.pm
@@ -16,7 +16,7 @@
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #
-# $Id: Iterator.pm,v 1.11 2005/10/15 13:31:42 dan Exp $
+# $Id: Iterator.pm,v 1.12 2005/10/17 22:28:01 dan Exp $
 
 =pod
 
@@ -202,7 +202,11 @@ sub get {
 
 	my $actual = $self->get_arg_type;
 	if ($actual != $type) {
-	    die "requested type '" . chr($type) . "' ($type) did not match wire type '" . chr($actual) . "' ($actual)";
+	    # "Be strict in what you send, be leniant in what you accept"
+	    #    - ie can't rely on python to send correct types, eg int32 vs uint32
+	    #die "requested type '" . chr($type) . "' ($type) did not match wire type '" . chr($actual) . "' ($actual)";
+	    warn "requested type '" . chr($type) . "' ($type) did not match wire type '" . chr($actual) . "' ($actual)";
+	    $type = $actual;
 	}
     } else {
 	$type = $self->get_arg_type;
diff --git a/lib/Net/DBus/RemoteObject.pm b/lib/Net/DBus/RemoteObject.pm
index ed5b1dd..840ea55 100644
--- a/lib/Net/DBus/RemoteObject.pm
+++ b/lib/Net/DBus/RemoteObject.pm
@@ -16,7 +16,7 @@
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #
-# $Id: RemoteObject.pm,v 1.15 2005/10/15 13:31:42 dan Exp $
+# $Id: RemoteObject.pm,v 1.16 2005/10/17 22:28:01 dan Exp $
 
 =pod
 
@@ -337,7 +337,7 @@ sub _call_method {
 	send_with_reply_and_block($call, $timeout * 1000);
     
     my @reply;
-    if ($ins && 0) { # Delibrately disabled, since python wont tell us about return values
+    if ($ins) {
 	@reply = $ins->decode($reply, "methods", $name, "returns");
     } else {
 	@reply = $reply->get_args_list;

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