[libnet-dbus-perl] 183/335: 100% pod documentation coverage
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:51 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 e03c2eb00ec614c2ccd034b5269efefebf3296bb
Author: Daniel P. Berrange <dan at berrange.com>
Date: Fri Feb 3 13:30:14 2006 +0000
100% pod documentation coverage
---
CHANGES | 4 +-
DBus.xs | 4 +-
lib/Net/DBus/Binding/Introspector.pm | 218 ++++++++++++++++++++++++++++++++++-
lib/Net/DBus/Binding/Iterator.pm | 131 ++++++++++++++++++++-
lib/Net/DBus/Binding/Message.pm | 186 +++++++++++++++++++++++++++++-
lib/Net/DBus/Object.pm | 8 +-
lib/Net/DBus/Test/MockConnection.pm | 81 ++++++++++++-
lib/Net/DBus/Test/MockObject.pm | 74 +++++++++++-
t/10-pod-coverage.t | 3 +-
9 files changed, 686 insertions(+), 23 deletions(-)
diff --git a/CHANGES b/CHANGES
index 1a45525..ec5bbd4 100644
--- a/CHANGES
+++ b/CHANGES
@@ -16,8 +16,8 @@ Changes since 0.32.3
- Fix numerous POD errors identified by Test::Pod and podchecker
- - Greatly expand coverage of API documentation to satisfy both
- users and the Test::Pod::Coverage tool!
+ - Increase POD documentation to get 100% coverage of all APIs,
+ verified by Test::Pod::Coverage
Changes since 0.32.2
diff --git a/DBus.xs b/DBus.xs
index 701b0e7..c940c3b 100644
--- a/DBus.xs
+++ b/DBus.xs
@@ -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: DBus.xs,v 1.20 2006/01/26 19:19:40 dan Exp $
+ * $Id: DBus.xs,v 1.21 2006/02/03 13:30:14 dan Exp $
*/
#include "EXTERN.h"
@@ -561,8 +561,6 @@ void
_unregister_object_path(con, path)
DBusConnection *con;
char *path;
- PREINIT:
- SV *code;
CODE:
/* The associated data will be free'd by the previously
registered callback */
diff --git a/lib/Net/DBus/Binding/Introspector.pm b/lib/Net/DBus/Binding/Introspector.pm
index 20262b4..6b5ccbe 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.13 2006/01/27 15:34:24 dan Exp $
+# $Id: Introspector.pm,v 1.14 2006/02/03 13:30:14 dan Exp $
=pod
@@ -158,6 +158,12 @@ sub new {
return $self;
}
+=item $ins->add_interface($name)
+
+Register the object as providing an interface with the name C<$name>
+
+=cut
+
sub add_interface {
my $self = shift;
my $name = shift;
@@ -169,6 +175,13 @@ sub add_interface {
} unless exists $self->{interfaces}->{$name};
}
+=item my $bool = $ins->has_interface($name)
+
+Return a true value if the object is registered as providing
+an interface with the name C<$name>; returns false otherwise.
+
+=cut
+
sub has_interface {
my $self = shift;
my $name = shift;
@@ -176,6 +189,13 @@ sub has_interface {
return exists $self->{interfaces}->{$name} ? 1 : 0;
}
+=item my @interfaces = $ins->has_method($name)
+
+Return a list of all interfaces provided by the object, which
+contain a method called C<$name>. This may be an empty list.
+
+=cut
+
sub has_method {
my $self = shift;
my $name = shift;
@@ -190,6 +210,14 @@ sub has_method {
return @interfaces;
}
+
+=item my @interfaces = $ins->has_signal($name)
+
+Return a list of all interfaces provided by the object, which
+contain a signal called C<$name>. This may be an empty list.
+
+=cut
+
sub has_signal {
my $self = shift;
my $name = shift;
@@ -204,6 +232,14 @@ sub has_signal {
}
+=item my @interfaces = $ins->has_property($name)
+
+Return a list of all interfaces provided by the object, which
+contain a property called C<$name>. This may be an empty list.
+
+=cut
+
+
sub has_property {
my $self = shift;
my $name = shift;
@@ -225,6 +261,17 @@ sub has_property {
}
+=item $ins->add_method($name, $params, $returns, $interface, $attributes);
+
+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.
+
+=cut
+
+
sub add_method {
my $self = shift;
my $name = shift;
@@ -242,6 +289,17 @@ sub add_method {
};
}
+
+=item $ins->add_signal($name, $params, $interface, $attributes);
+
+Register the object as providing a signal called C<$name> with parameters
+whose types are declared by C<$params>. The signal will be scoped to the inteface
+named by C<$interface>. The C<$attributes> parameter is a hash reference
+for annotating the signal.
+
+=cut
+
+
sub add_signal {
my $self = shift;
my $name = shift;
@@ -256,6 +314,16 @@ sub add_signal {
};
}
+=item $ins->add_property($name, $type, $access, $interface, $attributes);
+
+Register the object as providing a property called C<$name> with a type
+of C<$type>. The C<$access> parameter can be one of C<read>, C<write>,
+or C<readwrite>. The property will be scoped to the inteface
+named by C<$interface>. The C<$attributes> parameter is a hash reference
+for annotating the signal.
+
+=cut
+
sub add_property {
my $self = shift;
@@ -273,6 +341,13 @@ sub add_property {
};
}
+=item my $boolean = $ins->is_method_deprecated($name, $interface)
+
+Returns a true value if the method called C<$name> in the interface
+C<$interface> is marked as deprecated
+
+=cut
+
sub is_method_deprecated {
my $self = shift;
my $name = shift;
@@ -284,6 +359,12 @@ sub is_method_deprecated {
return 0;
}
+=item my $boolean = $ins->is_signal_deprecated($name, $interface)
+
+Returns a true value if the signal called C<$name> in the interface
+C<$interface> is marked as deprecated
+
+=cut
sub is_signal_deprecated {
my $self = shift;
@@ -296,6 +377,12 @@ sub is_signal_deprecated {
return 0;
}
+=item my $boolean = $ins->is_property_deprecated($name, $interface)
+
+Returns a true value if the property called C<$name> in the interface
+C<$interface> is marked as deprecated
+
+=cut
sub is_property_deprecated {
my $self = shift;
@@ -308,6 +395,12 @@ sub is_property_deprecated {
return 0;
}
+=item my $boolean = $ins->does_method_reply($name, $interface)
+
+Returns a true value if the method called C<$name> in the interface
+C<$interface> will generate a reply. Returns a false value otherwise.
+
+=cut
sub does_method_reply {
my $self = shift;
@@ -320,6 +413,12 @@ sub does_method_reply {
return 1;
}
+=item my @names = $ins->list_interfaces
+
+Returns a list of all interfaces registered as being provided
+by the object.
+
+=cut
sub list_interfaces {
my $self = shift;
@@ -327,29 +426,64 @@ sub list_interfaces {
return keys %{$self->{interfaces}};
}
+=item my @names = $ins->list_methods($interface)
+
+Returns a list of all methods registered as being provided
+by the object, within the interface C<$interface>.
+
+=cut
+
sub list_methods {
my $self = shift;
my $interface = shift;
return keys %{$self->{interfaces}->{$interface}->{methods}};
}
+=item my @names = $ins->list_signals($interface)
+
+Returns a list of all signals registered as being provided
+by the object, within the interface C<$interface>.
+
+=cut
+
sub list_signals {
my $self = shift;
my $interface = shift;
return keys %{$self->{interfaces}->{$interface}->{signals}};
}
+=item my @names = $ins->list_properties($interface)
+
+Returns a list of all properties registered as being provided
+by the object, within the interface C<$interface>.
+
+=cut
+
sub list_properties {
my $self = shift;
my $interface = shift;
return keys %{$self->{interfaces}->{$interface}->{props}};
}
+=item my $path = $ins->get_object_path
+
+Returns the path of the object associated with this introspection
+data
+
+=cut
+
sub get_object_path {
my $self = shift;
return $self->{object_path};
}
+=item my @types = $ins->get_method_params($interface, $name)
+
+Returns a list of declared data types for parameters of the
+method called C<$name> within the interface C<$interface>.
+
+=cut
+
sub get_method_params {
my $self = shift;
my $interface = shift;
@@ -357,6 +491,13 @@ sub get_method_params {
return @{$self->{interfaces}->{$interface}->{methods}->{$method}->{params}};
}
+=item my @types = $ins->get_method_returns($interface, $name)
+
+Returns a list of declared data types for return values of the
+method called C<$name> within the interface C<$interface>.
+
+=cut
+
sub get_method_returns {
my $self = shift;
my $interface = shift;
@@ -364,6 +505,13 @@ sub get_method_returns {
return @{$self->{interfaces}->{$interface}->{methods}->{$method}->{returns}};
}
+=item my @types = $ins->get_signal_params($interface, $name)
+
+Returns a list of declared data types for values associated with the
+signal called C<$name> within the interface C<$interface>.
+
+=cut
+
sub get_signal_params {
my $self = shift;
my $interface = shift;
@@ -371,6 +519,12 @@ sub get_signal_params {
return @{$self->{interfaces}->{$interface}->{signals}->{$signal}->{params}};
}
+=item my $type = $ins->get_property_type($interface, $name)
+
+Returns the declared data type for property called C<$name> within
+the interface C<$interface>.
+
+=cut
sub get_property_type {
my $self = shift;
@@ -379,6 +533,12 @@ sub get_property_type {
return $self->{interfaces}->{$interface}->{props}->{$prop}->{type};
}
+=item my $bool = $ins->is_property_readable($interface, $name);
+
+Returns a true value if the property called C<$name> within the
+interface C<$interface> can have its value read.
+
+=cut
sub is_property_readable {
my $self = shift;
@@ -388,6 +548,12 @@ sub is_property_readable {
return $access eq "readwrite" || $access eq "read" ? 1 : 0;
}
+=item my $bool = $ins->is_property_writable($interface, $name);
+
+Returns a true value if the property called C<$name> within the
+interface C<$interface> can have its value written to.
+
+=cut
sub is_property_writable {
my $self = shift;
@@ -613,6 +779,13 @@ sub _parse_property {
};
}
+=item my $xml = $ins->format
+
+Return a string containing an XML document representing the
+state of the introspection data.
+
+=cut
+
sub format {
my $self = shift;
@@ -622,6 +795,15 @@ sub format {
return $xml . $self->to_xml("");
}
+=item my $xml_fragment = $ins->to_xml
+
+Returns a string containing an XML fragment representing the
+state of the introspection data. This is basically the same
+as the C<format> method, but without the leading doctype
+declaration.
+
+=cut
+
sub to_xml {
my $self = shift;
my $indent = shift;
@@ -695,6 +877,12 @@ sub to_xml {
$xml .= $indent . "</node>\n";
}
+=item $type = $ins->to_xml_type($type)
+
+Takes a text-based representation of a data type and returns
+the compact representation used in XML introspection data.
+
+=cut
sub to_xml_type {
my $self = shift;
@@ -734,6 +922,15 @@ sub to_xml_type {
return $sig;
}
+=item $ins->encode($message, $type, $name, $direction, @args)
+
+Append a set of values <@args> to a message object C<$message>.
+The C<$type> parameter is either C<signal> or C<method> and
+C<$direction> is either C<params> or C<returns>. The introspection
+data will be queried to obtain the declared data types & the
+argument marshalling accordingly.
+
+=cut
sub encode {
my $self = shift;
@@ -779,13 +976,13 @@ sub encode {
unless $#types == $#args;
my $iter = $message->iterator(1);
- foreach my $t ($self->convert(@types)) {
+ foreach my $t ($self->_convert(@types)) {
$iter->append(shift @args, $t);
}
}
-sub convert {
+sub _convert {
my $self = shift;
my @in = @_;
@@ -794,7 +991,7 @@ sub convert {
if (ref($in) eq "ARRAY") {
my @subtype = @{$in};
shift @subtype;
- my @subout = $self->convert(@subtype);
+ 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];
@@ -810,13 +1007,22 @@ sub convert {
}
+=item my @args = $ins->decode($message, $type, $name, $direction)
+
+Unmarshalls the contents of a message object C<$message>.
+The C<$type> parameter is either C<signal> or C<method> and
+C<$direction> is either C<params> or C<returns>. The introspection
+data will be queried to obtain the declared data types & the
+arguments unmarshalled accordingly.
+
+=cut
+
sub decode {
my $self = shift;
my $message = shift;
my $type = shift;
my $name = shift;
my $direction = shift;
- my @args = @_;
my $interface = $message->get_interface;
@@ -847,7 +1053,7 @@ sub decode {
my $iter = $message->iterator;
- my @rawtypes = $self->convert(@types);
+ my @rawtypes = $self->_convert(@types);
my @ret;
do {
my $type = shift @types;
diff --git a/lib/Net/DBus/Binding/Iterator.pm b/lib/Net/DBus/Binding/Iterator.pm
index b050639..0ebf9fa 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.15 2006/01/27 15:34:24 dan Exp $
+# $Id: Iterator.pm,v 1.16 2006/02/03 13:30:14 dan Exp $
=pod
@@ -138,14 +138,16 @@ message iterator
=item $iter->append_int64($val);
Read or write a signed 64 bit value from/to the
-message iterator
+message iterator. An error will be raised if this
+build of Perl does not support 64 bit integers
=item my $val = $iter->get_uint64()
=item $iter->append_uint64($val);
Read or write an unsigned 64 bit value from/to the
-message iterator
+message iterator. An error will be raised if this
+build of Perl does not support 64 bit integers
=item my $val = $iter->get_double()
@@ -180,6 +182,17 @@ sub append_uint64 {
$self->_append_uint64(shift);
}
+=item my $value = $iter->get()
+
+=item my $value = $iter->get($type);
+
+Get the current value pointed to by this iterator. If the optional
+C<$type> parameter is supplied, the wire type will be compared with
+the desired type & a warning output if their differ. The C<$type>
+value must be one of the C<Net::DBus::Binding::Message::TYPE*>
+constants.
+
+=cut
sub get {
my $self = shift;
@@ -252,6 +265,12 @@ sub get {
}
}
+=item my $hashref = $iter->get_dict()
+
+If the iterator currently points to a dictionary value, unmarshalls
+and returns the value as a hash reference.
+
+=cut
sub get_dict {
my $self = shift;
@@ -272,6 +291,13 @@ sub get_dict {
return $dict;
}
+=item my $hashref = $iter->get_array()
+
+If the iterator currently points to an array value, unmarshalls
+and returns the value as a array reference.
+
+=cut
+
sub get_array {
my $self = shift;
my $array_type = shift;
@@ -292,6 +318,13 @@ sub get_array {
return $array;
}
+=item my $hashref = $iter->get_variant()
+
+If the iterator currently points to a variant value, unmarshalls
+and returns the value contained in the variant.
+
+=cut
+
sub get_variant {
my $self = shift;
@@ -299,6 +332,15 @@ sub get_variant {
return $iter->get();
}
+
+=item my $hashref = $iter->get_struct()
+
+If the iterator currently points to an struct value, unmarshalls
+and returns the value as a array reference. The values in the array
+correspond to members of the struct.
+
+=cut
+
sub get_struct {
my $self = shift;
@@ -314,6 +356,26 @@ sub get_struct {
return $struct;
}
+=item $iter->append($value)
+
+=item $iter->append($value, $type)
+
+Appends a value to the message associated with this iterator. The
+value is marshalled into wire format, according to the following
+rules.
+
+If the C<$value> is an instance of L<Net::DBus::Binding::Value>,
+the embedded data type is used.
+
+If the C<$type> parameter is supplied, that is taken to represent
+the data type. The type must be one of the C<Net::DBus::Binding::Message::TYPE_*>
+constants.
+
+Otherwise, the data type is chosen to be a string, dict or array
+according to the perl data types SCALAR, HASH or ARRAY.
+
+=cut
+
sub append {
my $self = shift;
my $value = shift;
@@ -371,6 +433,17 @@ sub append {
}
}
+
+=item my $type = $iter->guess_type($value)
+
+Make a best guess at the on the wire data type to use for
+marshalling C<$value>. If the value is a hash reference,
+the dictionary type is returned; if the value is an array
+reference the array type is returned; otherwise the string
+type is returned.
+
+=cut
+
sub guess_type {
my $self = shift;
my $value = shift;
@@ -396,6 +469,13 @@ sub guess_type {
}
}
+=item my $sig = $iter->get_signature($type)
+
+Given a data type representation, construct a corresponding
+signature string
+
+=cut
+
sub get_signature {
my $self = shift;
my $type = shift;
@@ -428,6 +508,13 @@ sub get_signature {
return $sig;
}
+=item $iter->append_array($value, $type)
+
+Append an array of values to the message. The C<$value> parameter
+must be an array reference, whose elements all have the same data
+type specified by the C<$type> parameter.
+
+=cut
sub append_array {
my $self = shift;
@@ -448,6 +535,15 @@ sub append_array {
}
+=item $iter->append_struct($value, $type)
+
+Append a struct to the message. The C<$value> parameter
+must be an array reference, whose elements correspond to
+members of the structure. The C<$type> parameter encodes
+the type of each member of the struct.
+
+=cut
+
sub append_struct {
my $self = shift;
my $struct = shift;
@@ -467,6 +563,14 @@ sub append_struct {
$self->_close_container($iter);
}
+=item $iter->append_dict($value, $type)
+
+Append a dictionary to the message. The C<$value> parameter
+must be an hash reference.The C<$type> parameter encodes
+the type of the key and value of the hash.
+
+=cut
+
sub append_dict {
my $self = shift;
my $hash = shift;
@@ -491,6 +595,14 @@ sub append_dict {
$self->_close_container($iter);
}
+=item $iter->append_variant($value)
+
+Append a value to the message, encoded as a variant type. The
+C<$value> can be of any type, however, the variant will be
+encoded as either a string, dictionary or array according to
+the rules of the C<guess_type> method.
+
+=cut
sub append_variant {
my $self = shift;
@@ -504,6 +616,19 @@ sub append_variant {
}
+=item my $type = $iter->get_arg_type
+
+Retrieves the type code of the value pointing to by this iterator.
+The returned code will correspond to one of the constants
+C<Net::DBus::Binding::Message::TYPE_*>
+
+=item my $type = $iter->get_element_type
+
+If the iterator points to an array, retrieves the type code of
+array elements. The returned code will correspond to one of the
+constants C<Net::DBus::Binding::Message::TYPE_*>
+
+=cut
1;
diff --git a/lib/Net/DBus/Binding/Message.pm b/lib/Net/DBus/Binding/Message.pm
index 7e7e7f5..e9c238b 100644
--- a/lib/Net/DBus/Binding/Message.pm
+++ b/lib/Net/DBus/Binding/Message.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: Message.pm,v 1.12 2006/01/27 15:34:24 dan Exp $
+# $Id: Message.pm,v 1.13 2006/02/03 13:30:14 dan Exp $
=pod
@@ -45,6 +45,81 @@ one of the four sub-types L<Net::DBus::Binding::Message::Signal>,
L<Net::DBus::Binding::Message::MethodCall>, L<Net::DBus::Binding::Message::MethodReturn>,
L<Net::DBus::Binding::Message::Error> should be used.
+=head1 CONSTANTS
+
+The following constants are defined in this module. They are
+not exported into the caller's namespace & thus must be referenced
+with their fully qualified package names
+
+=over 4
+
+=item TYPE_ARRAY
+
+Constant representing the signature value associated with the
+array data type.
+
+=item TYPE_BOOLEAN
+
+Constant representing the signature value associated with the
+boolean data type.
+
+=item TYPE_BYTE
+
+Constant representing the signature value associated with the
+byte data type.
+
+=item TYPE_DICT_ENTRY
+
+Constant representing the signature value associated with the
+dictionary entry data type.
+
+=item TYPE_DOUBLE
+
+Constant representing the signature value associated with the
+IEEE double precision floating point data type.
+
+=item TYPE_INT32
+
+Constant representing the signature value associated with the
+signed 32 bit integer data type.
+
+=item TYPE_INT64
+
+Constant representing the signature value associated with the
+signed 64 bit integer data type.
+
+=item TYPE_OBJECT_PATH
+
+Constant representing the signature value associated with the
+object path data type.
+
+=item TYPE_STRING
+
+Constant representing the signature value associated with the
+UTF-8 string data type.
+
+=item TYPE_STRUCT
+
+Constant representing the signature value associated with the
+struct data type.
+
+=item TYPE_UINT32
+
+Constant representing the signature value associated with the
+unsigned 32 bit integer data type.
+
+=item TYPE_UINT64
+
+Constant representing the signature value associated with the
+unsigned 64 bit integer data type.
+
+=item TYPE_VARIANT
+
+Constant representing the signature value associated with the
+variant data type.
+
+=back
+
=head1 METHODS
=over 4
@@ -65,6 +140,15 @@ use Net::DBus::Binding::Message::MethodCall;
use Net::DBus::Binding::Message::MethodReturn;
use Net::DBus::Binding::Message::Error;
+=item my $msg = Net::DBus::Binding::Message->new(message => $rawmessage);
+
+Creates a new message object, initializing it with the underlying C
+message object given by the C<message> object. This constructor is
+intended for internal use only, instead refer to one of the four
+sub-types for this class for specific message types
+
+=cut
+
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
@@ -100,59 +184,132 @@ sub _specialize {
}
}
+=item my $type = $msg->get_type
+
+Retrieves the type code for this message. The returned value corresponds
+to one of the four C<Net::DBus::Binding::Message::MESSAGE_TYPE_*> constants.
+
+=cut
+
sub get_type {
my $self = shift;
return $self->{message}->dbus_message_get_type;
}
+=item my $interface = $msg->get_interface
+
+Retrieves the name of the interface targetted by this message, possibly
+an empty string if there is no applicable interface for this message.
+
+=cut
+
sub get_interface {
my $self = shift;
return $self->{message}->dbus_message_get_interface;
}
+=item my $path = $msg->get_path
+
+Retrieves the object path associated with the message, possibly an
+empty string if there is no applicable object for this message.
+
+=cut
+
sub get_path {
my $self = shift;
return $self->{message}->dbus_message_get_path;
}
+=item my $name = $msg->get_destination
+
+Retrieves the uniqe or well-known bus name for client intended to be
+the recipient of the message. Possibly returns an empty string if
+the message is being broadcast to all clients.
+
+=cut
+
sub get_destination {
my $self = shift;
return $self->{message}->dbus_message_get_destination;
}
+=item my $name = $msg->get_sender
+
+Retireves the unique name of the client sending the message
+
+=cut
+
sub get_sender {
my $self = shift;
return $self->{message}->dbus_message_get_sender;
}
+=item my $serial = $msg->get_serial
+
+Retrieves the unique serial number of this message. The number
+is guarenteed unique for as long as the connection over which
+the message was sent remains open. May return zero, if the message
+is yet to be sent.
+
+=cut
+
sub get_serial {
my $self = shift;
return $self->{message}->dbus_message_get_serial;
}
+=item my $name = $msg->get_member
+
+For method calls, retrieves the name of the method to be invoked,
+while for signals, retrieves the name of the signal.
+
+=cut
+
sub get_member {
my $self = shift;
return $self->{message}->dbus_message_get_member;
}
+=item my $sig = $msg->get_signature
+
+Retrieves a string representing the type signature of the values
+packed into the body of the message.
+
+=cut
+
sub get_signature {
my $self = shift;
return $self->{message}->dbus_message_get_signature;
}
+=item $msg->set_sender($name)
+
+Set the name of the client sending the message. The name must
+be the unique name of the client.
+
+=cut
+
sub set_sender {
my $self = shift;
$self->{message}->dbus_message_set_sender(@_);
}
+=item $msg->set_destination($name)
+
+Set the name of the intended recipient of the message. This is
+typically used for signals to switch them from broadcast to
+unicast.
+
+=cut
+
sub set_destination {
my $self = shift;
$self->{message}->dbus_message_set_destination(@_);
@@ -177,6 +334,14 @@ sub iterator {
}
}
+=item my @values = $msg->get_args_list
+
+De-marshall all the values in the body of the message, using the
+message signature to identify data types. The values are returned
+as a list.
+
+=cut
+
sub get_args_list {
my $self = shift;
@@ -191,6 +356,14 @@ sub get_args_list {
return @ret;
}
+=item $msg->append_args_list(@values)
+
+Append a set of values to the body of the message. Values will
+be encoded as either a string, list or dictionary as appropriate
+to their Perl data type. For more specific data typing needs,
+the L<Net::DBus::Binding::Iterator> object should be used instead.
+
+=cut
sub append_args_list {
my $self = shift;
@@ -203,6 +376,17 @@ 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 f25e9f3..de3a315 100644
--- a/lib/Net/DBus/Object.pm
+++ b/lib/Net/DBus/Object.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: Object.pm,v 1.22 2006/01/27 15:34:24 dan Exp $
+# $Id: Object.pm,v 1.23 2006/02/03 13:30:14 dan Exp $
=pod
@@ -258,7 +258,7 @@ sub _unregister_child {
delete $self->{children}->{$object->get_object_path};
}
-=item my $service = $self->get_service
+=item my $service = $object->get_service
Retrieves the L<Net::DBus::Service> object within which this
object is exported.
@@ -271,7 +271,7 @@ sub get_service {
}
-=item my $path = $self->get_object_path
+=item my $path = $object->get_object_path
Retrieves the path under which this object is exported
@@ -282,7 +282,7 @@ sub get_object_path {
return $self->{object_path};
}
-=item $self->emit_signal_in($name, $interface, $client, @args);
+=item $object->emit_signal_in($name, $interface, $client, @args);
Emits a signal from the object, with a name of C<$name>. If the
C<$interface> parameter is defined, the signal will be scoped
diff --git a/lib/Net/DBus/Test/MockConnection.pm b/lib/Net/DBus/Test/MockConnection.pm
index eb09dcf..a2af4b4 100644
--- a/lib/Net/DBus/Test/MockConnection.pm
+++ b/lib/Net/DBus/Test/MockConnection.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: MockConnection.pm,v 1.4 2006/01/27 15:34:25 dan Exp $
+# $Id: MockConnection.pm,v 1.5 2006/02/03 13:30:14 dan Exp $
=pod
@@ -90,6 +90,17 @@ sub new {
return $self;
}
+=item $con->send($message)
+
+Send a message over the mock connection. If the message is
+a method call, it will be dispatched straight to any corresponding
+mock object registered. If the mesage is an error or method return
+it will be made available as a return value for the C<send_with_reply_and_block>
+method. If the message is a signal it will be queued up for processing
+by the C<dispatch> method.
+
+=cut
+
sub send {
my $self = shift;
@@ -108,6 +119,15 @@ sub send {
}
+=item $bus->request_name($service_name)
+
+Pretend to send a request to the bus registering the well known
+name specified in the C<$service_name> parameter. In reality
+this is just a no-op giving the impression that the name was
+successfully registered.
+
+=cut
+
sub request_name {
my $self = shift;
my $name = shift;
@@ -117,6 +137,17 @@ sub request_name {
# ....famous last words
}
+=item my $reply = $con->send_with_reply_and_block($msg)
+
+Send a message over the mock connection and wait for a
+reply. The C<$msg> should be an instance of C<Net::DBus::Binding::Message::MethodCall>
+and the return C<$reply> will be an instance of C<Net::DBus::Binding::Message::MethodReturn>.
+It is also possible that an error will be thrown, with
+the thrown error being blessed into the C<Net::DBus::Error>
+class.
+
+=cut
+
sub send_with_reply_and_block {
my $self = shift;
my $msg = shift;
@@ -144,6 +175,14 @@ sub send_with_reply_and_block {
return $reply;
}
+=item $con->dispatch;
+
+Dispatches any pending messages in the incoming queue
+to their message handlers. This method should be called
+by test suites whenever they anticipate that there are
+pending signals to be dealt with.
+
+=cut
sub dispatch {
my $self = shift;
@@ -158,6 +197,16 @@ sub dispatch {
}
}
+=item $con->add_filter($coderef);
+
+Adds a filter to the connection which will be invoked whenever a
+message is received. The C<$coderef> should be a reference to a
+subroutine, which returns a true value if the message should be
+filtered out, or a false value if the normal message dispatch
+should be performed.
+
+=cut
+
sub add_filter {
my $self = shift;
my $cb = shift;
@@ -165,6 +214,17 @@ sub add_filter {
push @{$self->{filters}}, $cb;
}
+=item $con->register_object_path($path, \&handler)
+
+Registers a handler for messages whose path matches
+that specified in the C<$path> parameter. The supplied
+code reference will be invoked with two parameters, the
+connection object on which the message was received,
+and the message to be processed (an instance of the
+C<Net::DBus::Binding::Message> class).
+
+=cut
+
sub register_object_path {
my $self = shift;
my $path = shift;
@@ -173,6 +233,17 @@ sub register_object_path {
$self->{objects}->{$path} = $code;
}
+=item $con->register_fallback($path, \&handler)
+
+Registers a handler for messages whose path starts with
+the prefix specified in the C<$path> parameter. The supplied
+code reference will be invoked with two parameters, the
+connection object on which the message was received,
+and the message to be processed (an instance of the
+C<Net::DBus::Binding::Message> class).
+
+=cut
+
sub register_fallback {
my $self = shift;
my $path = shift;
@@ -182,6 +253,14 @@ sub register_fallback {
$self->{objectTrees}->{$path} = $code;
}
+=item $con->unregister_object_path($path)
+
+Unregisters the handler associated with the object path C<$path>. The
+handler would previously have been registered with the C<register_object_path>
+or C<register_fallback> methods.
+
+=cut
+
sub unregister_object_path {
my $self = shift;
my $path = shift;
diff --git a/lib/Net/DBus/Test/MockObject.pm b/lib/Net/DBus/Test/MockObject.pm
index ce963fd..6e5d151 100644
--- a/lib/Net/DBus/Test/MockObject.pm
+++ b/lib/Net/DBus/Test/MockObject.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: MockObject.pm,v 1.4 2006/01/27 15:34:25 dan Exp $
+# $Id: MockObject.pm,v 1.5 2006/02/03 13:30:14 dan Exp $
=pod
@@ -112,39 +112,111 @@ sub new {
}
+=item my $service = $object->get_service
+
+Retrieves the L<Net::DBus::Service> object within which this
+object is exported.
+
+=cut
sub get_service {
my $self = shift;
return $self->{service};
}
+=item my $path = $object->get_object_path
+
+Retrieves the path under which this object is exported
+
+=cut
+
sub get_object_path {
my $self = shift;
return $self->{object_path};
}
+
+=item my $msg = $object->get_last_message
+
+Retrieves the last message processed by this object. The returned
+object is an instance of L<Net::DBus::Binding::Message>
+
+=cut
+
sub get_last_message {
my $self = shift;
return $self->{message};
}
+=item my $sig = $object->get_last_message_signature
+
+Retrieves the type signature of the last processed message.
+
+=cut
+
sub get_last_message_signature {
my $self = shift;
return $self->{message}->get_signature;
}
+=item my $value = $object->get_last_message_param
+
+Returns the first value supplied as an argument to the last
+processed message.
+
+=cut
+
sub get_last_message_param {
my $self = shift;
my @args = $self->{message}->get_args_list;
return $args[0];
}
+=item my @values = $object->get_last_message_param_list
+
+Returns a list of all the values supplied as arguments to
+the last processed message.
+
+=cut
+
sub get_last_message_param_list {
my $self = shift;
my @args = $self->{message}->get_args_list;
return \@args;
}
+=item $object->seed_action($interface, $method, %action);
+
+Registers an action to be performed when a message corresponding
+to the method C<$method> within the interface C<$interface> is
+received. The C<%action> parameter can have a number of possible
+keys set:
+
+=over 4
+
+=item signals
+
+Causes a signal to be emitted when the method is invoked. The
+value associated with this key should be an instance of the
+L<Net::DBus::Binding::Message::Signal> class.
+
+=item error
+
+Causes an error to be generated when the method is invoked. The
+value associated with this key should be a hash reference, with
+two elements. The first, C<name>, giving the error name, and the
+second, C<description>, providing the descriptive text.
+
+=item reply
+
+Causes a normal method return to be generated. The value associated
+with this key should be an array reference, whose elements are the
+values to be returned by the method.
+
+=back
+
+=cut
+
sub seed_action {
my $self = shift;
my $interface = shift;
diff --git a/t/10-pod-coverage.t b/t/10-pod-coverage.t
index 07e86dc..7d9a0a2 100644
--- a/t/10-pod-coverage.t
+++ b/t/10-pod-coverage.t
@@ -3,5 +3,4 @@
use Test::More;
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
-plan skip_all => "disabled until coverage is complete";
-#all_pod_coverage_ok();
+all_pod_coverage_ok();
--
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