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 <d...@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 _______________________________________________ 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