[libnet-dbus-perl] 261/335: Added signal param names, and explicitly track method return names separately from param names
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:08:08 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 5dcbbd386cb64fe359721c31bf8215aae706d89c
Author: Daniel P. Berrange <berrange at redhat.com>
Date: Sat Feb 16 14:12:38 2008 -0500
Added signal param names, and explicitly track method return names separately from param names
---
lib/Net/DBus/Binding/Introspector.pm | 84 ++++++++++++++++++++++++++++++------
lib/Net/DBus/Exporter.pm | 48 ++++++++++++++-------
t/40-introspector.t | 44 +++++++++++--------
t/45-exporter.t | 8 ++--
4 files changed, 132 insertions(+), 52 deletions(-)
diff --git a/lib/Net/DBus/Binding/Introspector.pm b/lib/Net/DBus/Binding/Introspector.pm
index 6a74771..46debae 100644
--- a/lib/Net/DBus/Binding/Introspector.pm
+++ b/lib/Net/DBus/Binding/Introspector.pm
@@ -265,14 +265,14 @@ sub has_property {
}
}
-=item $ins->add_method($name, $params, $returns, $interface, $attributes, $names);
+=item $ins->add_method($name, $params, $returns, $interface, $attributes, $paramnames, $returnnames);
Register the object as providing a method called C<$name> accepting parameters
whose types are declared by C<$params> and returning values whose type
are declared by C<$returns>. The method will be scoped to the inteface
named by C<$interface>. The C<$attributes> parameter is a hash reference
-for annotating the method. The C<$names> parameter is a list of argument
-and return value names.
+for annotating the method. The C<$paramnames> and C<$returnames> parameters
+are a list of argument and return value names.
=cut
@@ -283,13 +283,15 @@ sub add_method {
my $returns = shift;
my $interface = shift;
my $attributes = shift;
- my $names = shift;
+ my $paramnames = shift;
+ my $returnnames = shift;
$self->add_interface($interface);
$self->{interfaces}->{$interface}->{methods}->{$name} = {
params => $params,
returns => $returns,
- names => $names,
+ paramnames => $paramnames,
+ returnnames => $returnnames,
deprecated => $attributes->{deprecated} ? 1 : 0,
no_reply => $attributes->{no_return} ? 1 : 0,
};
@@ -310,10 +312,12 @@ sub add_signal {
my $params = shift;
my $interface = shift;
my $attributes = shift;
+ my $paramnames = shift;
$self->add_interface($interface);
$self->{interfaces}->{$interface}->{signals}->{$name} = {
params => $params,
+ paramnames => $paramnames,
deprecated => $attributes->{deprecated} ? 1 : 0,
};
}
@@ -506,6 +510,20 @@ sub get_method_params {
return @{$self->{interfaces}->{$interface}->{methods}->{$method}->{params}};
}
+=item my @types = $ins->get_method_param_names($interface, $name)
+
+Returns a list of declared names for parameters of the
+method called C<$name> within the interface C<$interface>.
+
+=cut
+
+sub get_method_param_names {
+ my $self = shift;
+ my $interface = shift;
+ my $method = shift;
+ return @{$self->{interfaces}->{$interface}->{methods}->{$method}->{paramnames}};
+}
+
=item my @types = $ins->get_method_returns($interface, $name)
Returns a list of declared data types for return values of the
@@ -520,6 +538,20 @@ sub get_method_returns {
return @{$self->{interfaces}->{$interface}->{methods}->{$method}->{returns}};
}
+=item my @types = $ins->get_method_return_names($interface, $name)
+
+Returns a list of declared names for return values of the
+method called C<$name> within the interface C<$interface>.
+
+=cut
+
+sub get_method_return_names {
+ my $self = shift;
+ my $interface = shift;
+ my $method = shift;
+ return @{$self->{interfaces}->{$interface}->{methods}->{$method}->{returnnames}};
+}
+
=item my @types = $ins->get_signal_params($interface, $name)
Returns a list of declared data types for values associated with the
@@ -534,6 +566,20 @@ sub get_signal_params {
return @{$self->{interfaces}->{$interface}->{signals}->{$signal}->{params}};
}
+=item my @types = $ins->get_signal_param_names($interface, $name)
+
+Returns a list of declared names for values associated with the
+signal called C<$name> within the interface C<$interface>.
+
+=cut
+
+sub get_signal_param_names {
+ my $self = shift;
+ my $interface = shift;
+ my $signal = shift;
+ return @{$self->{interfaces}->{$interface}->{signals}->{$signal}->{paramnames}};
+}
+
=item my $type = $ins->get_property_type($interface, $name)
Returns the declared data type for property called C<$name> within
@@ -637,7 +683,8 @@ sub _parse_method {
my $name = $node->att("name");
my @params;
my @returns;
- my @names;
+ my @paramnames;
+ my @returnnames;
my $deprecated = 0;
my $no_reply = 0;
foreach my $child ($node->children("arg")) {
@@ -649,10 +696,10 @@ sub _parse_method {
my @type = $self->_parse_type(\@sig);
if (!defined $direction || $direction eq "in") {
push @params, @type;
- push @names, $name;
+ push @paramnames, $name;
} elsif ($direction eq "out") {
push @returns, @type;
- push @names, $name;
+ push @returnnames, $name;
}
}
foreach my $child ($node->children("annotation")) {
@@ -671,7 +718,8 @@ sub _parse_method {
returns => \@returns,
no_reply => $no_reply,
deprecated => $deprecated,
- names => \@names,
+ paramnames => \@paramnames,
+ returnnames => \@returnnames,
}
}
@@ -738,12 +786,15 @@ sub _parse_signal {
my $name = $node->att("name");
my @params;
+ my @paramnames;
my $deprecated = 0;
foreach my $child ($node->children("arg")) {
my $type = $child->att("type");
+ my $name = $child->att("name");
my @sig = split //, $type;
my @type = $self->_parse_type(\@sig);
push @params, @type;
+ push @paramnames, $name;
}
foreach my $child ($node->children("annotation")) {
my $name = $child->att("name");
@@ -756,6 +807,7 @@ sub _parse_signal {
$self->{interfaces}->{$interface}->{signals}->{$name} = {
params => \@params,
+ paramnames => \@paramnames,
deprecated => $deprecated,
};
}
@@ -824,16 +876,19 @@ sub to_xml {
my $method = $interface->{methods}->{$mname};
$xml .= $indent . ' <method name="' . $mname . '">' . "\n";
- my @names = map{ $_ ? "name=\"$_\" " : '' } ( @{$method->{names}} );
+ my @paramnames = map{ $_ ? "name=\"$_\" " : '' } ( @{$method->{paramnames}} );
+ my @returnnames = map{ $_ ? "name=\"$_\" " : '' } ( @{$method->{returnnames}} );
foreach my $type (@{$method->{params}}) {
next if ! ref($type) && exists $magic_type_map{$type};
- $xml .= $indent . ' <arg ' . (@names ? shift(@names) : "") . 'type="' . $self->to_xml_type($type) . '" direction="in"/>' . "\n";
+ $xml .= $indent . ' <arg ' . (@paramnames ? shift(@paramnames) : "")
+ . 'type="' . $self->to_xml_type($type) . '" direction="in"/>' . "\n";
}
foreach my $type (@{$method->{returns}}) {
next if ! ref($type) && exists $magic_type_map{$type};
- $xml .= $indent . ' <arg ' . (@names ? shift(@names) : "") . 'type="' . $self->to_xml_type($type) . '" direction="out"/>' . "\n";
+ $xml .= $indent . ' <arg ' . (@returnnames ? shift(@returnnames) : "")
+ . 'type="' . $self->to_xml_type($type) . '" direction="out"/>' . "\n";
}
if ($method->{deprecated}) {
$xml .= $indent . ' <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>' . "\n";
@@ -847,9 +902,12 @@ sub to_xml {
my $signal = $interface->{signals}->{$sname};
$xml .= $indent . ' <signal name="' . $sname . '">' . "\n";
+ my @paramnames = map{ $_ ? "name=\"$_\" " : '' } ( @{$signal->{paramnames}} );
+
foreach my $type (@{$signal->{params}}) {
next if ! ref($type) && exists $magic_type_map{$type};
- $xml .= $indent . ' <arg type="' . $self->to_xml_type($type) . '"/>' . "\n";
+ $xml .= $indent . ' <arg ' . (@paramnames ? shift(@paramnames) : "")
+ . 'type="' . $self->to_xml_type($type) . '"/>' . "\n";
}
if ($signal->{deprecated}) {
$xml .= $indent . ' <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>' . "\n";
diff --git a/lib/Net/DBus/Exporter.pm b/lib/Net/DBus/Exporter.pm
index 86a5bf8..c64ddb4 100644
--- a/lib/Net/DBus/Exporter.pm
+++ b/lib/Net/DBus/Exporter.pm
@@ -220,10 +220,15 @@ it may disappear altogether in a future release. Clients will typically
print out a warning message when a deprecated method/signal/property
is used.
-=item arg_names
+=item param_names
-An array of strings specifying names for the input parameters and
-return values of the method. If omitted, no names will be assigned.
+An array of strings specifying names for the input parameters of the
+method or signal. If omitted, no names will be assigned.
+
+=item return_names
+
+An array of strings specifying names for the return parameters of the
+method. If omitted, no names will be assigned.
=back
@@ -322,16 +327,16 @@ sub _dbus_introspector_add {
my $exports = $dbus_exports{$class};
if ($exports) {
foreach my $method (keys %{$exports->{methods}}) {
- my ($params, $returns, $interface, $attributes, $names) = @{$exports->{methods}->{$method}};
- $introspector->add_method($method, $params, $returns, $interface, $attributes, $names);
+ my ($params, $returns, $interface, $attributes, $paramnames, $returnnames) = @{$exports->{methods}->{$method}};
+ $introspector->add_method($method, $params, $returns, $interface, $attributes, $paramnames, $returnnames);
}
foreach my $prop (keys %{$exports->{props}}) {
my ($type, $access, $interface, $attributes) = @{$exports->{props}->{$prop}};
$introspector->add_property($prop, $type, $access, $interface, $attributes);
}
foreach my $signal (keys %{$exports->{signals}}) {
- my ($params, $interface, $attributes) = @{$exports->{signals}->{$signal}};
- $introspector->add_signal($signal, $params, $interface, $attributes);
+ my ($params, $interface, $attributes, $paramnames) = @{$exports->{signals}->{$signal}};
+ $introspector->add_signal($signal, $params, $interface, $attributes, $paramnames);
}
}
@@ -365,7 +370,6 @@ values.
sub dbus_method {
my $name = shift;
- my $arg_names = [];
my $params = [];
my $returns = [];
my $caller = caller;
@@ -389,12 +393,18 @@ sub dbus_method {
die "interface not specified & no default interface defined";
}
- if ( $attributes{arg_names} ) {
- $arg_names = $attributes{arg_names} if ref($attributes{arg_names}) eq "ARRAY";
- delete($attributes{arg_names});
+ my $param_names = [];
+ if ( $attributes{param_names} ) {
+ $param_names = $attributes{param_names} if ref($attributes{param_names}) eq "ARRAY";
+ delete($attributes{param_names});
+ }
+ my $return_names = [];
+ if ( $attributes{return_names} ) {
+ $return_names = $attributes{return_names} if ref($attributes{return_names}) eq "ARRAY";
+ delete($attributes{return_names});
}
- $dbus_exports{$caller}->{methods}->{$name} = [$params, $returns, $interface, \%attributes, $arg_names];
+ $dbus_exports{$caller}->{methods}->{$name} = [$params, $returns, $interface, \%attributes, $param_names, $return_names];
}
@@ -438,9 +448,9 @@ sub dbus_property {
}
-=item dbus_signal($name, $params);
+=item dbus_signal($name, $params, [\%attributes]);
-=item dbus_signal($name, $params, $interface);
+=item dbus_signal($name, $params, $interface, [\%attributes]);
Exports a signal called C<$name>, having parameters whose types
are defined by C<$params>, and returning values whose types are
@@ -475,7 +485,13 @@ sub dbus_signal {
die "interface not specified & no default interface defined";
}
- $dbus_exports{$caller}->{signals}->{$name} = [$params, $interface, \%attributes];
+ my $param_names = [];
+ if ( $attributes{param_names} ) {
+ $param_names = $attributes{param_names} if ref($attributes{param_names}) eq "ARRAY";
+ delete($attributes{param_names});
+ }
+
+ $dbus_exports{$caller}->{signals}->{$name} = [$params, $interface, \%attributes, $param_names];
}
1;
@@ -553,7 +569,7 @@ Or giving names to input parameters:
system "mpg123 $track &";
}
- dbus_method("PlayMP3", ["string"], [], { arg_names => ["track"] });
+ dbus_method("PlayMP3", ["string"], [], { param_names => ["track"] });
=back
diff --git a/t/40-introspector.t b/t/40-introspector.t
index a98b7d9..dd88baa 100644
--- a/t/40-introspector.t
+++ b/t/40-introspector.t
@@ -18,12 +18,14 @@ TEST_ONE: {
"hello" => {
params => ["int32", "int32", ["struct", "int32","byte"]],
returns => ["int32"],
- names => ["wibble", "eek", "frob"],
+ paramnames => ["wibble", "eek"],
+ returnnames => ["frob"],
},
"goodbye" => {
params => [["array", ["struct", "int32", "string"]]],
returns => ["string", "string"],
- names => ["ooh", "ahh", "eek"],
+ paramnames => ["ooh"],
+ returnnames => ["ahh", "eek"],
},
},
signals => {
@@ -57,8 +59,8 @@ TEST_ONE: {
<method name="hello">
<arg name="wibble" type="i" direction="in"/>
<arg name="eek" type="i" direction="in"/>
- <arg name="frob" type="(iy)" direction="in"/>
- <arg type="i" direction="out"/>
+ <arg type="(iy)" direction="in"/>
+ <arg name="frob" type="i" direction="out"/>
</method>
<signal name="meltdown">
<arg type="i"/>
@@ -81,32 +83,36 @@ EOF
"hello" => {
params => ["int32", "int32", ["struct", "int32","byte"]],
returns => ["uint32"],
- names => [],
+ paramnames => [],
+ returnnames => [],
},
"goodbye" => {
params => [["array", ["dict", "int32", "string"]]],
returns => ["string", ["array", "string"]],
- names => [],
+ paramnames => [],
+ returnnames => [],
},
},
signals => {
"meltdown" => {
params => ["int32", "byte"],
+ paramnames => [],
}
},
},
"org.example.OtherInterface" => {
- methods => {
- "hitme" => {
- params => ["int32", "uint32"],
- return => [],
- names => [],
- }
- },
- props => {
- "title" => { type => "string", access => "readwrite"},
- "salary" => { type => "int32", access => "read"},
- },
+ methods => {
+ "hitme" => {
+ params => ["int32", "uint32"],
+ return => [],
+ paramnames => [],
+ returnnames => [],
+ }
+ },
+ props => {
+ "title" => { type => "string", access => "readwrite"},
+ "salary" => { type => "int32", access => "read"},
+ },
},
},
children => [
@@ -158,8 +164,8 @@ EOF
<method name="hello">
<arg name="wibble" type="i" direction="in"/>
<arg name="eek" type="i" direction="in"/>
- <arg name="frob" type="(iy)" direction="in"/>
- <arg type="i" direction="out"/>
+ <arg type="(iy)" direction="in"/>
+ <arg name="frob" type="i" direction="out"/>
</method>
<signal name="meltdown">
<arg type="i"/>
diff --git a/t/45-exporter.t b/t/45-exporter.t
index b1cc469..4c853fc 100644
--- a/t/45-exporter.t
+++ b/t/45-exporter.t
@@ -36,7 +36,7 @@ dbus_method("EverythingInterfaceNegativeAnnotate", ["string"], ["int32"], "org.e
# Now test 'defaults'
dbus_method("NoArgsReturns");
-dbus_method("NoReturns", ["string"], [], { arg_names => ["wizz"] });
+dbus_method("NoReturns", ["string"], [], { param_names => ["wizz"] });
dbus_method("NoArgs",[],["int32"]);
dbus_method("NoArgsReturnsInterface", "org.example.OtherObject");
dbus_method("NoReturnsInterface", ["string"], "org.example.OtherObject");
@@ -46,8 +46,8 @@ dbus_method("NoArgsReturnsAnnotate", { deprecated => 1 });
dbus_method("NoReturnsAnnotate", ["string"], { deprecated => 1 });
dbus_method("NoArgsAnnotate",[],["int32"], { deprecated => 1 });
dbus_method("NoArgsReturnsInterfaceAnnotate", "org.example.OtherObject", { deprecated => 1 });
-dbus_method("NoReturnsInterfaceAnnotate", ["string"], "org.example.OtherObject", { deprecated => 1, arg_names => ["one"] });
-dbus_method("NoArgsInterfaceAnnotate", [],["int32"], "org.example.OtherObject", { deprecated => 1 });
+dbus_method("NoReturnsInterfaceAnnotate", ["string"], "org.example.OtherObject", { deprecated => 1, param_names => ["one"] });
+dbus_method("NoArgsInterfaceAnnotate", [],["int32"], "org.example.OtherObject", { deprecated => 1, return_names => ["two"] });
@@ -115,7 +115,7 @@ my $wantxml = <<EOF;
<arg type="i" direction="out"/>
</method>
<method name="NoArgsInterfaceAnnotate">
- <arg type="i" direction="out"/>
+ <arg name="two" type="i" direction="out"/>
<annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
</method>
<method name="NoArgsReturnsInterface">
--
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