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 8b638e878b661f2394a546ab33259b49e6453316
Author: Daniel P. Berrange <berra...@redhat.com>
Date:   Thu Apr 13 11:06:53 2006 -0400

    Added binding for signature & object paths and changed way 
(get|set)_no_reply is done
---
 DBus.xs                              |  51 ++++++++++++++---
 lib/Net/DBus.pm                      |  51 +++++++++++++++--
 lib/Net/DBus/Binding/Introspector.pm |  18 ++++--
 lib/Net/DBus/Binding/Iterator.pm     | 104 ++++++++++++++++++++++++++---------
 lib/Net/DBus/Binding/Message.pm      |  48 +++++++++++-----
 lib/Net/DBus/Object.pm               |   4 +-
 6 files changed, 215 insertions(+), 61 deletions(-)

diff --git a/DBus.xs b/DBus.xs
index 79d31cb..053da4d 100644
--- a/DBus.xs
+++ b/DBus.xs
@@ -787,14 +787,6 @@ _create(type)
     OUTPUT:
         RETVAL
 
-void
-set_no_reply(msg, status)
-        DBusMessage *msg;
-        dbus_bool_t status;
-    CODE:
-        dbus_message_set_no_reply(msg, status);
-
-
 
 DBusMessageIter *
 _iterator_append(msg)
@@ -829,6 +821,15 @@ DESTROY(msg)
         PD_DEBUG("  Member %s\n", dbus_message_get_member(msg) ? 
dbus_message_get_member(msg) : "");
         dbus_message_unref(msg);
 
+dbus_bool_t
+dbus_message_get_no_reply(msg)
+       DBusMessage *msg;
+
+void
+dbus_message_set_no_reply(msg,flag)
+       DBusMessage *msg;
+        dbus_bool_t flag;
+
 int
 dbus_message_get_type(msg)
        DBusMessage *msg;
@@ -1210,6 +1211,22 @@ get_string(iter)
     OUTPUT:
         RETVAL
 
+char *
+get_signature(iter)
+        DBusMessageIter *iter;
+    CODE:
+        dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+        RETVAL
+
+char *
+get_object_path(iter)
+        DBusMessageIter *iter;
+    CODE:
+        dbus_message_iter_get_basic(iter, &RETVAL);
+    OUTPUT:
+        RETVAL
+
 
 void
 append_boolean(iter, val)
@@ -1301,6 +1318,24 @@ append_string(iter, val)
           croak("cannot append string");
         }
 
+void
+append_object_path(iter, val)
+        DBusMessageIter *iter;
+        char *val;
+    CODE:
+        if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_OBJECT_PATH, 
&val)) {
+          croak("cannot append object path");
+        }
+
+void
+append_signature(iter, val)
+        DBusMessageIter *iter;
+        char *val;
+    CODE:
+        if (!dbus_message_iter_append_basic(iter, DBUS_TYPE_SIGNATURE, &val)) {
+          croak("cannot append signature");
+        }
+
 
 
 void
diff --git a/lib/Net/DBus.pm b/lib/Net/DBus.pm
index 509a944..dd579e4 100644
--- a/lib/Net/DBus.pm
+++ b/lib/Net/DBus.pm
@@ -22,7 +22,7 @@
 
 =head1 NAME
 
-DBus - Perl extension for the DBus message system
+Net::DBus - Perl extension for the DBus message system
 
 =head1 SYNOPSIS
 
@@ -111,11 +111,13 @@ use vars qw(@EXPORT_OK %EXPORT_TAGS);
 
 @EXPORT_OK = qw(dbus_int16 dbus_uint16 dbus_int32 dbus_uint32 dbus_int64 
dbus_uint64 
                dbus_byte dbus_boolean dbus_string dbus_double
-               dbus_struct dbus_array dbus_dict);
+                dbus_object_path dbus_signature
+               dbus_struct dbus_array dbus_dict dbus_variant);
 
 %EXPORT_TAGS = (typing => [qw(dbus_int16 dbus_uint16 dbus_int32 dbus_uint32 
dbus_int64 dbus_uint64 
                              dbus_byte dbus_boolean dbus_string dbus_double
-                             dbus_struct dbus_array dbus_dict)]);
+                              dbus_object_path dbus_signature
+                             dbus_struct dbus_array dbus_dict dbus_variant)]);
 
 =item my $bus = Net::DBus->find(%params);
 
@@ -633,6 +635,32 @@ sub dbus_string {
                                          $_[0]);
 }
 
+=item $typed_value = dbus_signature($value);
+
+Mark a value as being a UTF-8 string, whose contents is a valid 
+type signature
+
+=cut
+
+
+
+sub dbus_signature {
+    return 
Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_SIGNATURE,
+                                         $_[0]);
+}
+
+=item $typed_value = dbus_object_path($value);
+
+Mark a value as being a UTF-8 string, whose contents is a valid
+object path.
+
+=cut
+
+sub dbus_object_path {
+    return 
Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_OBJECT_PATH,
+                                         $_[0]);
+}
+
 =item $typed_value = dbus_boolean($value);
 
 Mark a value as being an boolean
@@ -654,7 +682,7 @@ Mark a value as being an array
 
 
 sub dbus_array {
-    return 
Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_ARRAY,
+    return 
Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_ARRAY],
                                          $_[0]);
 }
 
@@ -666,7 +694,7 @@ Mark a value as being a structure
 
 
 sub dbus_struct {
-    return 
Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_STRUCT,
+    return 
Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_STRUCT],
                                          $_[0]);
 }
 
@@ -677,7 +705,18 @@ Mark a value as being a dictionary
 =cut
 
 sub dbus_dict{
-    return 
Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_DICT_ENTRY,
+    return 
Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_DICT_ENTRY],
+                                         $_[0]);
+}
+
+=item $typed_value = dbus_variant($value);
+
+Mark a value as being a variant
+
+=cut
+
+sub dbus_variant{
+    return 
Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_VARIANT],
                                          $_[0]);
 }
 
diff --git a/lib/Net/DBus/Binding/Introspector.pm 
b/lib/Net/DBus/Binding/Introspector.pm
index d1085a8..d715d6a 100644
--- a/lib/Net/DBus/Binding/Introspector.pm
+++ b/lib/Net/DBus/Binding/Introspector.pm
@@ -59,7 +59,6 @@ use Carp;
 use XML::Grove::Builder;
 use XML::Parser::PerlSAX;
 
-use Net::DBus;
 use Net::DBus::Binding::Message;
 
 our %simple_type_map = (
@@ -73,8 +72,8 @@ our %simple_type_map = (
   "uint32" => &Net::DBus::Binding::Message::TYPE_UINT32,
   "int64" => &Net::DBus::Binding::Message::TYPE_INT64,
   "uint64" => &Net::DBus::Binding::Message::TYPE_UINT64,
-  "object" => &Net::DBus::Binding::Message::TYPE_OBJECT_PATH,
-  "variant" => &Net::DBus::Binding::Message::TYPE_VARIANT,
+  "objectpath" => &Net::DBus::Binding::Message::TYPE_OBJECT_PATH, 
+  "signature" => &Net::DBus::Binding::Message::TYPE_SIGNATURE,
 );
 
 our %simple_type_rev_map = (
@@ -88,8 +87,8 @@ our %simple_type_rev_map = (
   &Net::DBus::Binding::Message::TYPE_UINT32 => "uint32",
   &Net::DBus::Binding::Message::TYPE_INT64 => "int64",
   &Net::DBus::Binding::Message::TYPE_UINT64 => "uint64",
-  &Net::DBus::Binding::Message::TYPE_OBJECT_PATH => "object",
-  &Net::DBus::Binding::Message::TYPE_VARIANT => "variant",
+  &Net::DBus::Binding::Message::TYPE_OBJECT_PATH => "objectpath", 
+  &Net::DBus::Binding::Message::TYPE_SIGNATURE => "signature",
 );
 
 our %magic_type_map = (
@@ -109,6 +108,7 @@ our %compound_type_map = (
   "array" => &Net::DBus::Binding::Message::TYPE_ARRAY,
   "struct" => &Net::DBus::Binding::Message::TYPE_STRUCT,
   "dict" => &Net::DBus::Binding::Message::TYPE_DICT_ENTRY,
+  "variant" => &Net::DBus::Binding::Message::TYPE_VARIANT,
 );
 
 =item my $ins = Net::DBus::Binding::Introspector->new(object_path => 
$object_path,
@@ -915,6 +915,11 @@ sub to_xml_type {
            $sig .= $self->to_xml_type($type->[1]);
            $sig .= $self->to_xml_type($type->[2]);
            $sig .= "}";
+       } elsif ($type->[0] eq "variant") {
+           if ($#{$type} != 0) {
+               die "dict spec must contain no sub-types";
+           }
+           $sig .= chr($compound_type_map{"variant"});
        } else {
            die "unknown/unsupported compound type " . $type->[0] . " expecting 
'array', 'struct', or 'dict'";
        }
@@ -978,7 +983,7 @@ sub encode {
 
     die "expected " . int(@types) . " $direction, but got " . int(@args) 
        unless $#types == $#args;
-    
+
     my $iter = $message->iterator(1);
     foreach my $t ($self->_convert(@types)) {
        $iter->append(shift @args, $t);
@@ -998,6 +1003,7 @@ sub _convert {
            my @subout = $self->_convert(@subtype);
            die "unknown compound type " . $in->[0] unless
                exists $compound_type_map{lc $in->[0]};
+
            push @out, [$compound_type_map{lc $in->[0]}, \@subout];
        } elsif (exists $magic_type_map{lc $in}) {
            push @out, $magic_type_map{lc $in};
diff --git a/lib/Net/DBus/Binding/Iterator.pm b/lib/Net/DBus/Binding/Iterator.pm
index 9f53dcc..925e806 100644
--- a/lib/Net/DBus/Binding/Iterator.pm
+++ b/lib/Net/DBus/Binding/Iterator.pm
@@ -119,6 +119,20 @@ message iterator.
 Read or write a UTF-8 string value from/to the
 message iterator
 
+=item my $val = $iter->get_object_path()
+
+=item $iter->append_object_path($val);
+
+Read or write a UTF-8 string value, whose contents is
+a valid object path, from/to the message iterator
+
+=item my $val = $iter->get_signature()
+
+=item $iter->append_signature($val);
+
+Read or write a UTF-8 string, whose contents is a 
+valid type signature, value from/to the message iterator
+
 =item my $val = $iter->get_int16()
 
 =item $iter->append_int16($val);
@@ -275,9 +289,9 @@ sub get {
     } elsif ($type == &Net::DBus::Binding::Message::TYPE_INVALID) {
        confess "cannot handle Net::DBus::Binding::Message::TYPE_INVALID";
     } elsif ($type == &Net::DBus::Binding::Message::TYPE_OBJECT_PATH) {
-       return $self->get_string();
+       return $self->get_object_path();
     } elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
-       return $self->get_string();
+       return $self->get_signature();
     } else {
        confess "unknown argument type '" . chr($type) . "' ($type)";
     }
@@ -398,7 +412,7 @@ sub append {
     my $self = shift;
     my $value = shift;
     my $type = shift;
-    
+
     if (ref($value) eq "Net::DBus::Binding::Value") {
        $type = $value->type;
        $value = $value->value;
@@ -411,17 +425,19 @@ sub append {
     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) {
            $self->append_struct($value, $subtype);
        } elsif ($maintype == &Net::DBus::Binding::Message::TYPE_ARRAY) {
            $self->append_array($value, $subtype);
+       } elsif ($maintype == &Net::DBus::Binding::Message::TYPE_VARIANT) {
+           $self->append_variant($value, $subtype);
        } else {
-           confess "Unsupported compound type ", $maintype;
+           confess "Unsupported compound type ", $maintype, " ('", 
chr($maintype), "')";
        }
-    } else {   
+    } else {
        # XXX is this good idea or not
        $value = '' unless defined $value;
 
@@ -446,11 +462,11 @@ sub append {
        } elsif ($type == &Net::DBus::Binding::Message::TYPE_DOUBLE) {
            $self->append_double($value);
        } elsif ($type == &Net::DBus::Binding::Message::TYPE_OBJECT_PATH) {
-           $self->append_string($value);
-       } elsif ($type == &Net::DBus::Binding::Message::TYPE_VARIANT) {
-           $self->append_variant($value);
+           $self->append_object_path($value);
+       } elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
+           $self->append_signature($value);
        } else {
-           confess "Unsupported scalar type ", $type;
+           confess "Unsupported scalar type ", $type, " ('", chr($type), "')";
        }
     }
 }
@@ -469,9 +485,31 @@ type is returned.
 sub guess_type {
     my $self = shift;
     my $value = shift;
-    
+
     if (ref($value)) {
-       if (ref($value) eq "HASH") {
+       if (UNIVERSAL::isa($value, "Net::DBus::Binding::Value")) {
+           my $type = $value->type;
+           if (ref($type) && ref($type) eq "ARRAY") {
+               my $maintype = $type->[0];
+               my $subtype = $type->[1];
+
+               if (!defined $subtype) {
+                   if ($maintype == 
&Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
+                       $subtype = [ 
$self->guess_type(($value->value())[0]->[0]), 
+                                    
$self->guess_type(($value->value())[0]->[1]) ];
+                   } elsif ($maintype == 
&Net::DBus::Binding::Message::TYPE_ARRAY) {
+                       $subtype = [ 
$self->guess_type(($value->value())[0]->[0]) ];
+                   } elsif ($maintype == 
&Net::DBus::Binding::Message::TYPE_STRUCT) {
+                       $subtype = [ map { $self->guess_type($_) } 
@{($value->value())[0]} ];
+                   } else {
+                       die "Unguessable compound type '$maintype' ('", 
chr($maintype), "')\n";
+                   }
+               }
+               return [$maintype, $subtype];
+           } else {
+               return $type;
+           }
+       } elsif (ref($value) eq "HASH") {
            my $key = (keys %{$value})[0];
            my $val = $value->{$key};
            # XXX Basically impossible to decide between DICT & STRUCT
@@ -491,32 +529,32 @@ sub guess_type {
     }
 }
 
-=item my $sig = $iter->get_signature($type)
+=item my $sig = $iter->format_signature($type)
 
 Given a data type representation, construct a corresponding 
 signature string
 
 =cut
 
-sub get_signature {
+sub format_signature {
     my $self = shift;
     my $type = shift;
     my ($sig, $t, $i);
 
     $sig = "";
-    $i = 0;
+    $i = 0;use Data::Dumper;
 
     if (ref($type) eq "ARRAY") {
        while ($i <= $#{$type}) {
            $t = $$type[$i];
            
            if (ref($t) eq "ARRAY") {
-               $sig .= $self->get_signature($t);
+               $sig .= $self->format_signature($t);
            } elsif ($t == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
                $sig .= chr (&Net::DBus::Binding::Message::TYPE_ARRAY);
-               $sig .= "{" . $self->get_signature($$type[++$i]) . "}";
+               $sig .= "{" . $self->format_signature($$type[++$i]) . "}";
            } elsif ($t == &Net::DBus::Binding::Message::TYPE_STRUCT) {
-               $sig .= "(" . $self->get_signature($$type[++$i]) . ")";
+               $sig .= "(" . $self->format_signature($$type[++$i]) . ")";
            } else {
                $sig .= chr($t);
            }
@@ -542,11 +580,15 @@ sub append_array {
     my $self = shift;
     my $array = shift;
     my $type = shift;
+    
+    if (!defined($type)) {
+       $type = [$self->guess_type($array->[0])];
+    }
 
     die "array must only have one type"
        if $#{$type} > 0;
 
-    my $sig = $self->get_signature($type);
+    my $sig = $self->format_signature($type);
     my $iter = 
$self->_open_container(&Net::DBus::Binding::Message::TYPE_ARRAY, $sig);
     
     foreach my $value (@{$array}) {
@@ -571,13 +613,14 @@ sub append_struct {
     my $struct = shift;
     my $type = shift;
 
-    if ($#{$struct} != $#{$type}) {
+    if (defined($type) &&
+       $#{$struct} != $#{$type}) {
        die "number of values does not match type";
     }
 
     my $iter = 
$self->_open_container(&Net::DBus::Binding::Message::TYPE_STRUCT, "");
     
-    my @type = @{$type};
+    my @type = defined $type ? @{$type} : ();
     foreach my $value (@{$struct}) {
        $iter->append($value, shift @type);
     }
@@ -601,7 +644,7 @@ sub append_dict {
     my $sig;
 
     $sig  = "{";
-    $sig .= $self->get_signature($type);
+    $sig .= $self->format_signature($type);
     $sig .= "}";
 
     my $iter = 
$self->_open_container(&Net::DBus::Binding::Message::TYPE_ARRAY, $sig);
@@ -629,11 +672,20 @@ the rules of the C<guess_type> method.
 sub append_variant {
     my $self = shift;
     my $value = shift;
-    
-    my $type = $self->guess_type($value);
-    my $sig = $self->get_signature($type);
+    my $type = shift;
+
+    if (UNIVERSAL::isa($value, "Net::DBus::Binding::Value")) {
+       $type = [$self->guess_type($value)];
+       $value = $value->value;
+    } elsif (!defined $type || !defined $type->[0]) {
+       $type = [$self->guess_type($value)];
+    }
+    die "variant must only have one type"
+       if defined $type && $#{$type} > 0;
+
+    my $sig = $self->format_signature($type->[0]);
     my $iter = 
$self->_open_container(&Net::DBus::Binding::Message::TYPE_VARIANT, $sig);
-    $iter->append($value, $type);
+    $iter->append($value, $type->[0]);
     $self->_close_container($iter);
 }
 
diff --git a/lib/Net/DBus/Binding/Message.pm b/lib/Net/DBus/Binding/Message.pm
index c1a1355..0ecbdab 100644
--- a/lib/Net/DBus/Binding/Message.pm
+++ b/lib/Net/DBus/Binding/Message.pm
@@ -103,6 +103,11 @@ object path data type.
 Constant representing the signature value associated with the
 UTF-8 string data type.
 
+=item TYPE_SIGNATURE
+
+Constant representing the signature value associated with the
+signature data type.
+
 =item TYPE_STRUCT
 
 Constant representing the signature value associated with the
@@ -143,7 +148,6 @@ use strict;
 use warnings;
 use Carp;
 
-use Net::DBus;
 use Net::DBus::Binding::Iterator;
 use Net::DBus::Binding::Message::Signal;
 use Net::DBus::Binding::Message::MethodCall;
@@ -344,6 +348,36 @@ sub iterator {
     }
 }
 
+=item $boolean = $msg->get_no_reply()
+
+Gets the flag indicating whether the message is expecting
+a reply to be sent. 
+
+=cut
+
+sub get_no_reply {
+    my $self = shift;
+    
+    return $self->{message}->dbus_message_get_no_reply;
+}
+
+=item $msg->set_no_reply($boolean)
+
+Toggles the flag indicating whether the message is expecting
+a reply to be sent. All method call messages expect a reply
+by default. By toggling this flag the communication latency
+is reduced by removing the need for the client to wait
+
+=cut
+
+
+sub set_no_reply {
+    my $self = shift;
+    my $flag = shift;
+    
+    $self->{message}->dbus_message_set_no_reply($flag);
+}
+
 =item my @values = $msg->get_args_list
 
 De-marshall all the values in the body of the message, using the 
@@ -385,18 +419,6 @@ sub append_args_list {
     }
 }
 
-
-# The following methods documented, are in the XS module
-
-=item $msg->set_no_reply($boolean)
-
-Toggles the flag indicating whether the message is expecting
-a reply to be sent. All method call messages expect a reply
-by default. By toggling this flag the communication latency
-is reduced by removing the need for the client to wait
-
-=cut
-
 # To keep autoloader quiet
 sub DESTROY {
 }
diff --git a/lib/Net/DBus/Object.pm b/lib/Net/DBus/Object.pm
index de3a315..0af5e01 100644
--- a/lib/Net/DBus/Object.pm
+++ b/lib/Net/DBus/Object.pm
@@ -135,8 +135,8 @@ use Net::DBus::Binding::Message::MethodReturn;
 
 dbus_method("Introspect", [], ["string"]);
 
-dbus_method("Get", ["string", "string"], ["variant"], 
"org.freedesktop.DBus.Properties");
-dbus_method("Set", ["string", "string", "variant"], [], 
"org.freedesktop.DBus.Properties");
+dbus_method("Get", ["string", "string"], [["variant"]], 
"org.freedesktop.DBus.Properties");
+dbus_method("Set", ["string", "string", ["variant"]], [], 
"org.freedesktop.DBus.Properties");
 
 =item my $object = Net::DBus::Object->new($service, $path)
 

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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to