[libnet-dbus-perl] 84/335: Guess type data if none is supplied

[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 0b09a32d6f81d00f795a11c957a61e7b9e4b042a
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Mon Aug 29 12:37:20 2005 +0000

    Guess type data if none is supplied
---
 lib/Net/DBus/Binding/Iterator.pm | 30 +++++++++++++++++++++++++++++-
 1 file changed, 29 insertions(+), 1 deletion(-)

diff --git a/lib/Net/DBus/Binding/Iterator.pm b/lib/Net/DBus/Binding/Iterator.pm
index ae56b93..9cbe2f9 100644
--- a/lib/Net/DBus/Binding/Iterator.pm
+++ b/lib/Net/DBus/Binding/Iterator.pm
@@ -299,10 +299,14 @@ sub append {
     my $value = shift;
     my $type = shift;
     
+    if (!defined $type) {
+	$type = $self->guess_type($value);
+    }
+
     if (ref($type) eq "ARRAY") {
 	my $maintype = $type->[0];
 	my $subtype = $type->[1];
-
+	
 	if ($maintype == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
 	    $self->append_dict($value, $subtype);
 	} elsif ($maintype == &Net::DBus::Binding::Message::TYPE_STRUCT) {
@@ -337,6 +341,30 @@ sub append {
     }
 }
 
+sub guess_type {
+    my $self = shift;
+    my $value = shift;
+    
+    if (ref($value)) {
+	if (ref($value) eq "HASH") {
+	    my $key = (keys %{$value})[0];
+	    my $val = $value->{$key};
+	    # XXX Basically impossible to decide between DICT & STRUCT
+	    return [ &Net::DBus::Binding::Message::TYPE_DICT_ENTRY,
+		     [ &Net::DBus::Binding::Message::TYPE_STRING, $self->guess_type($val)] ];
+	} elsif (ref($value) eq "ARRAY") {
+	    return [ &Net::DBus::Binding::Message::TYPE_ARRAY,
+		     [$self->guess_type($value->[0])] ];
+	} else {
+	    die "cannot marshall reference of type " . ref($value);
+	}
+    } else {
+	# XXX Should be bother trying to guess integer & floating point types ?
+	# I say sod it, because strongly typed languages will support introspection
+	# and loosely typed languages won't care about the difference
+	return &Net::DBus::Binding::Message::TYPE_STRING;
+    }
+}
 
 sub get_signature {
     my $type = shift;

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