[libnet-dbus-perl] 157/335: Re-add support for explicit data typing, to deal with cases where introspection data is missing, or incomplete, but client needs to strongly type values
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:45 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 d04d2b761d2dd91d1f3996de6ff8ec7d77f33046
Author: Daniel P. Berrange <dan at berrange.com>
Date: Mon Nov 21 11:39:51 2005 +0000
Re-add support for explicit data typing, to deal with cases where introspection data is missing, or incomplete, but client needs to strongly type values
---
lib/Net/DBus.pm | 218 +++++++++++++++++++++++++++++++++++++--
lib/Net/DBus/Binding/Iterator.pm | 19 ++--
lib/Net/DBus/Binding/Value.pm | 93 +++++++++++++++++
3 files changed, 315 insertions(+), 15 deletions(-)
diff --git a/lib/Net/DBus.pm b/lib/Net/DBus.pm
index 584ebf5..1a3f627 100644
--- a/lib/Net/DBus.pm
+++ b/lib/Net/DBus.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: DBus.pm,v 1.19 2005/10/23 16:34:12 dan Exp $
+# $Id: DBus.pm,v 1.20 2005/11/21 11:39:51 dan Exp $
=pod
@@ -92,7 +92,7 @@ use Carp;
BEGIN {
- our $VERSION = '0.32.2';
+ our $VERSION = '0.32.3';
require XSLoader;
XSLoader::load('Net::DBus', $VERSION);
}
@@ -100,9 +100,23 @@ BEGIN {
use Net::DBus::Binding::Bus;
use Net::DBus::Service;
use Net::DBus::RemoteService;
+use Net::DBus::Test::MockConnection;
+use Net::DBus::Binding::Value;
use vars qw($bus_system $bus_session);
+use Exporter qw(import);
+
+use vars qw(@EXPORT_OK %EXPORT_TAGS);
+
+ at EXPORT_OK = qw(dbus_int32 dbus_uint32 dbus_int64 dbus_uint64
+ dbus_byte dbus_boolean dbus_string dbus_double
+ dbus_struct dbus_array dbus_dict);
+
+%EXPORT_TAGS = (typing => [qw(dbus_int32 dbus_uint32 dbus_int64 dbus_uint64
+ dbus_byte dbus_boolean dbus_string dbus_double
+ dbus_struct dbus_array dbus_dict)]);
+
=pod
=item my $bus = Net::DBus->find(%params);
@@ -149,7 +163,7 @@ sub find {
=item my $bus = Net::DBus->system(%params);
-Return a connection to the system message bus. Note that the
+Return a handle for the system message bus. Note that the
system message bus is locked down by default, so unless appropriate
access control rules are added in /etc/dbus/system.d/, an application
may access services, but won't be able to export services.
@@ -172,7 +186,7 @@ sub system {
=item my $bus = Net::DBus->session(%params);
-Return a connection to the session message bus.
+Return a handle for the session message bus.
The optional C<params> hash can contain be used to specify
connection options. The only support option at this time
is C<nomainloop> which prevents the bus from being automatically
@@ -188,6 +202,25 @@ sub session {
return $bus_session;
}
+
+=pod
+
+=item my $bus = Net::DBus->test(%params);
+
+Returns a handle for a virtual bus for use in unit tests. This bus does
+not make any network connections, but rather has an in-memory message
+pipeline. Consult L<Net::DBus::Test::MockConnection> for further details
+of how to use this special bus.
+
+=cut
+
+# NB. explicitly do *NOT* cache, since unit tests
+# should always have pristine state
+sub test {
+ my $class = shift;
+ return $class->_new(Net::DBus::Test::MockConnection->new());
+}
+
=pod
=item my $bus = Net::DBus->new($address, %params);
@@ -500,6 +533,178 @@ sub _signal_func {
=back
+=head1 DATA TYPING METHODS
+
+These methods are not usually used, since most services provide introspection
+data to inform clients of their data typing requirements. If introspection data
+is incomplete, however, it may be neccessary for a client to mark values with
+specific data types. In such a case, the following methods can be used. They
+are not, however, exported by default so must be requested at import time by
+specifying 'use Net::DBus qw(:typing)'
+
+=over 4
+
+=item $typed_value = dbus_int32($value);
+
+Mark a value as being a signed, 32-bit integer.
+
+=cut
+
+sub dbus_int32 {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_INT32);
+}
+
+=pod
+
+=item $typed_value = dbus_uint32($value);
+
+Mark a value as being an unsigned, 32-bit integer.
+
+=cut
+
+
+sub dbus_uint32 {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_UINT32);
+}
+
+=pod
+
+=item $typed_value = dbus_int64($value);
+
+Mark a value as being an unsigned, 64-bit integer.
+
+=cut
+
+
+
+sub dbus_int64 {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_INT64);
+}
+
+=pod
+
+=item $typed_value = dbus_uint64($value);
+
+Mark a value as being an unsigned, 64-bit integer.
+
+=cut
+
+
+
+sub dbus_uint64 {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_UINT64);
+}
+
+=pod
+
+=item $typed_value = dbus_double($value);
+
+Mark a value as being a double precision IEEE floating point.
+
+=cut
+
+
+
+sub dbus_double {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_DOUBLE);
+}
+
+=pod
+
+=item $typed_value = dbus_byte($value);
+
+Mark a value as being an unsigned, byte.
+
+=cut
+
+
+
+sub dbus_byte {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_BYTE);
+}
+
+=pod
+
+=item $typed_value = dbus_string($value);
+
+Mark a value as being a UTF-8 string. This is not usually required
+since 'string' is the default data type for any Perl scalar value.
+
+=cut
+
+
+
+sub dbus_string {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_STRING);
+}
+
+=pod
+
+=item $typed_value = dbus_boolean($value);
+
+Mark a value as being an boolean
+
+=cut
+
+
+
+sub dbus_boolean {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_BOOLEAN);
+}
+
+=pod
+
+=item $typed_value = dbus_array($value);
+
+Mark a value as being an array
+
+=cut
+
+
+sub dbus_array {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_ARRAY);
+}
+
+=pod
+
+=item $typed_value = dbus_struct($value);
+
+Mark a value as being a structure
+
+=cut
+
+
+sub dbus_struct {
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_STRUCT);
+}
+
+=pod
+
+=item $typed_value = dbus_dict($value);
+
+Mark a value as being a dictionary
+
+=cut
+
+sub dbus_dict{
+ return Net::DBus::Binding::Value->new($_[0],
+ &Net::DBus::Binding::Message::TYPE_DICT_ENTRY);
+}
+
+=pod
+
+=back
+
=head1 SEE ALSO
L<Net::DBus>, L<Net::DBus::RemoteService>, L<Net::DBus::Service>,
@@ -511,13 +716,10 @@ L<dbus-monitor(1)>, L<dbus-daemon-1(1)>, L<dbus-send(1)>, L<http://dbus.freedesk
Daniel Berrange <dan at berrange.com>
-=head1 COPYRIGHT AND LICENSE
+=head1 COPYRIGHT
Copyright 2004-2005 by Daniel Berrange
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
=cut
1;
diff --git a/lib/Net/DBus/Binding/Iterator.pm b/lib/Net/DBus/Binding/Iterator.pm
index a298a0a..dedac2a 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.13 2005/10/23 16:31:15 dan Exp $
+# $Id: Iterator.pm,v 1.14 2005/11/21 11:39:51 dan Exp $
=pod
@@ -321,9 +321,14 @@ sub append {
my $value = shift;
my $type = shift;
+ if (ref($value) eq "Net::DBus::Binding::Value") {
+ $type = $value->type;
+ $value = $value->value;
+ }
+
if (!defined $type) {
$type = $self->guess_type($value);
- }
+ }
if (ref($type) eq "ARRAY") {
my $maintype = $type->[0];
@@ -338,7 +343,10 @@ sub append {
} else {
confess "Unsupported compound type ", $maintype;
}
- } else {
+ } else {
+ # XXX is this good idea or not
+ $value = '' unless defined $value;
+
if ($type == &Net::DBus::Binding::Message::TYPE_BOOLEAN) {
$self->append_boolean($value);
} elsif ($type == &Net::DBus::Binding::Message::TYPE_BYTE) {
@@ -513,11 +521,8 @@ L<Net::DBus::Binding::Message>
Daniel Berrange E<lt>dan at berrange.comE<gt>
-=head1 COPYRIGHT AND LICENSE
+=head1 COPYRIGHT
Copyright 2004 by Daniel Berrange
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
=cut
diff --git a/lib/Net/DBus/Binding/Value.pm b/lib/Net/DBus/Binding/Value.pm
new file mode 100644
index 0000000..47f4e46
--- /dev/null
+++ b/lib/Net/DBus/Binding/Value.pm
@@ -0,0 +1,93 @@
+# -*- perl -*-
+#
+# Copyright (C) 2004-2005 Daniel P. Berrange
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# $Id: Value.pm,v 1.3 2005/11/21 11:39:51 dan Exp $
+
+=pod
+
+=head1 NAME
+
+Net::DBus::Binding::Value - a strongly typed data value
+
+=head1 SYNOPSIS
+
+ # Import the convenience functions
+ use Net::DBus qw(:typing);
+
+ # Call a method with passing an int32
+ $object->doit(dint32("3"));
+
+
+=head1 DESCRIPTION
+
+This module provides a simple wrapper around a raw Perl value,
+associating an explicit DBus type with the value. This is used
+in cases where a client is communicating with a server which does
+not provide introspection data, but for which the basic data types
+are not sufficient. This class should not be used directly, rather
+the convenience functions in L<Net::DBus> be called.
+
+=cut
+
+package Net::DBus::Binding::Value;
+
+use strict;
+use warnings;
+
+sub new {
+ my $class = shift;
+ my $self = [];
+
+ $self->[0] = shift;
+ $self->[1] = shift;
+
+ bless $self, $class;
+
+ return $self;
+}
+
+
+sub value {
+ my $self = shift;
+ return $self->[0];
+}
+
+sub type {
+ my $self = shift;
+ return $self->[1];
+}
+
+1;
+
+=pod
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::Binding::Introspector>, L<Net::DBus::Binding::Iterator>
+
+=head1 AUTHOR
+
+Daniel Berrange E<lt>dan at berrange.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004-2005 by Daniel Berrange
+
+=cut
--
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