3
# Copyright (C) 2004-2011 Daniel P. Berrange
5
# This program is free software; You can redistribute it and/or modify
6
# it under the same terms as Perl itself. Either:
8
# a) the GNU General Public License as published by the Free
9
# Software Foundation; either version 2, or (at your option) any
14
# b) the "Artistic License"
16
# The file "COPYING" distributed along with this file provides full
17
# details of the terms and conditions of the two licenses.
23
Net::DBus::Exporter - Export object methods and signals to the bus
27
# Define a new package for the object we're going
29
package Demo::HelloWorld;
31
# Specify the main interface provided by our object
32
use Net::DBus::Exporter qw(org.example.demo.Greeter);
34
# We're going to be a DBus object
35
use base qw(Net::DBus::Object);
37
# Ensure only explicitly exported methods can be invoked
40
# Export a 'Greeting' signal taking a stringl string parameter
41
dbus_signal("Greeting", ["string"]);
43
# Export 'Hello' as a method accepting a single string
44
# parameter, and returning a single string value
45
dbus_method("Hello", ["string"], ["string"]);
47
# Export 'Goodbye' as a method accepting a single string
48
# parameter, and returning a single string, but put it
49
# in the 'org.exaple.demo.Farewell' interface
50
dbus_method("Goodbye", ["string"], ["string"], "org.example.demo.Farewell");
54
The C<Net::DBus::Exporter> module is used to export methods
55
and signals defined in an object to the message bus. Since
56
Perl is a loosely typed language it is not possible to automatically
57
determine correct type information for methods to be exported.
58
Thus when sub-classing L<Net::DBus::Object>, this package will
59
provide the type information for methods and signals.
61
When importing this package, an optional argument can be supplied
62
to specify the default interface name to associate with methods
63
and signals, for which an explicit interface is not specified.
64
Thus in the common case of objects only providing a single interface,
65
this removes the need to repeat the interface name against each
70
When specifying scalar data types for parameters and return values,
71
the following string constants must be used to denote the data
72
type. When values corresponding to these types are (un)marshalled
73
they are represented as the Perl SCALAR data type (see L<perldata>).
79
A UTF-8 string of characters
83
A 16-bit signed integer
87
A 16-bit unsigned integer
91
A 32-bit signed integer
95
A 32-bit unsigned integer
99
A 64-bit signed integer. NB, this type is not supported by
100
many builds of Perl on 32-bit platforms, so if used, your
101
data is liable to be truncated at 32-bits.
105
A 64-bit unsigned integer. NB, this type is not supported by
106
many builds of Perl on 32-bit platforms, so if used, your
107
data is liable to be truncated at 32-bits.
119
An IEEE double-precision floating point
123
=head1 COMPOUND TYPES
125
When specifying compound data types for parameters and return
126
values, an array reference must be used, with the first element
127
being the name of the compound type.
131
=item ["array", ARRAY-TYPE]
133
An array of values, whose type os C<ARRAY-TYPE>. The C<ARRAY-TYPE>
134
can be either a scalar type name, or a nested compound type. When
135
values corresponding to the array type are (un)marshalled, they
136
are represented as the Perl ARRAY data type (see L<perldata>). If,
137
for example, a method was declared to have a single parameter with
138
the type, ["array", "string"], then when calling the method one
139
would provide a array reference of strings:
141
$object->hello(["John", "Doe"])
143
=item ["dict", KEY-TYPE, VALUE-TYPE]
145
A dictionary of values, more commonly known as a hash table. The
146
C<KEY-TYPE> is the name of the scalar data type used for the dictionary
147
keys. The C<VALUE-TYPE> is the name of the scalar, or compound
148
data type used for the dictionary values. When values corresponding
149
to the dict type are (un)marshalled, they are represented as the
150
Perl HASH data type (see L<perldata>). If, for example, a method was
151
declared to have a single parameter with the type ["dict", "string", "string"],
152
then when calling the method one would provide a hash reference
155
$object->hello({forename => "John", surname => "Doe"});
157
=item ["struct", VALUE-TYPE-1, VALUE-TYPE-2]
159
A structure of values, best thought of as a variation on the array
160
type where the elements can vary. Many languages have an explicit
161
name associated with each value, but since Perl does not have a
162
native representation of structures, they are represented by the
163
LIST data type. If, for exaple, a method was declared to have a single
164
parameter with the type ["struct", "string", "string"], corresponding
172
then, when calling the method one would provide an array refernce
173
with the values orded to match the structure
175
$object->hello(["John", "Doe"]);
181
When specifying introspection data for an exported service, there
182
are a couple of so called C<magic> types. Parameters declared as
183
magic types are not visible to clients, but instead their values
184
are provided automatically by the server side bindings. One use of
185
magic types is to get an extra parameter passed with the unique
186
name of the caller invoking the method.
192
The value passed in is the unique name of the caller of the method.
193
Unique names are strings automatically assigned to client connections
194
by the bus daemon, for example ':1.15'
198
The value passed in is an integer within the scope of a caller, which
199
increments on every method call.
205
When exporting methods, signals & properties, in addition to the core
206
data typing information, a number of metadata annotations are possible.
207
These are specified by passing a hash reference with the desired keys
208
as the last parameter when defining the export. The following annotations
209
are currently supported
215
Indicate that this method does not return any value, and thus no reply
216
message should be sent over the wire, likewise informing the clients
217
not to expect / wait for a reply message
221
Indicate that use of this method/signal/property is discouraged, and
222
it may disappear altogether in a future release. Clients will typically
223
print out a warning message when a deprecated method/signal/property
228
An array of strings specifying names for the input parameters of the
229
method or signal. If omitted, no names will be assigned.
233
An array of strings specifying names for the return parameters of the
234
method. If omitted, no names will be assigned.
244
package Net::DBus::Exporter;
246
use vars qw(@ISA @EXPORT %dbus_exports %dbus_introspectors);
248
use Net::DBus::Binding::Introspector;
256
@EXPORT = qw(dbus_method dbus_signal dbus_property dbus_no_strict_exports);
263
if (exists $dbus_exports{$caller}) {
264
warn "$caller is already registered with Net::DBus::Exporter";
268
$dbus_exports{$caller} = {
274
die "usage: use Net::DBus::Exporter 'interface-name';" unless @_;
276
my $interface = shift;
277
&_validate_interface($interface);
278
$dbus_exports{$caller}->{interface} = $interface;
280
$class->export_to_level(1, "", @EXPORT);
283
sub _dbus_introspector {
286
if (!exists $dbus_exports{$class}) {
287
# If this class has not been exported, lets look
288
# at the parent class & return its introspection
291
if (defined (*{"${class}::ISA"})) {
292
my @isa = @{"${class}::ISA"};
293
foreach my $parent (@isa) {
294
# We don't recurse to Net::DBus::Object
295
# since we need to give sub-classes the
296
# choice of not supporting introspection
297
next if $parent eq "Net::DBus::Object";
299
my $ins = &_dbus_introspector($parent);
308
unless (exists $dbus_introspectors{$class}) {
309
my $is = Net::DBus::Binding::Introspector->new(strict=>$dbus_exports{$class}->{strict});
310
&_dbus_introspector_add($class, $is);
311
$dbus_introspectors{$class} = $is;
314
return $dbus_introspectors{$class};
317
sub _dbus_introspector_add {
319
my $introspector = shift;
321
my $exports = $dbus_exports{$class};
323
foreach my $method (keys %{$exports->{methods}}) {
324
my ($params, $returns, $interface, $attributes, $paramnames, $returnnames) = @{$exports->{methods}->{$method}};
325
$introspector->add_method($method, $params, $returns, $interface, $attributes, $paramnames, $returnnames);
327
foreach my $prop (keys %{$exports->{props}}) {
328
my ($type, $access, $interface, $attributes) = @{$exports->{props}->{$prop}};
329
$introspector->add_property($prop, $type, $access, $interface, $attributes);
331
foreach my $signal (keys %{$exports->{signals}}) {
332
my ($params, $interface, $attributes, $paramnames) = @{$exports->{signals}->{$signal}};
333
$introspector->add_signal($signal, $params, $interface, $attributes, $paramnames);
337
if (defined (*{"${class}::ISA"})) {
339
my @isa = @{"${class}::ISA"};
340
foreach my $parent (@isa) {
341
&_dbus_introspector_add($parent, $introspector);
346
=item dbus_method($name, $params, $returns, [\%annotations]);
348
=item dbus_method($name, $params, $returns, $interface, [\%annotations]);
350
Exports a method called C<$name>, having parameters whose types
351
are defined by C<$params>, and returning values whose types are
352
defined by C<$returns>. If the C<$interface> parameter is
353
provided, then the method is associated with that interface, otherwise
354
the default interface for the calling package is used. The
355
value for the C<$params> parameter should be an array reference
356
with each element defining the data type of a parameter to the
357
method. Likewise, the C<$returns> parameter should be an array
358
reference with each element defining the data type of a return
359
value. If it not possible to export a method which accepts a
360
variable number of parameters, or returns a variable number of
370
my $interface = $dbus_exports{$caller}->{interface};
373
if (@_ && ref($_[0]) eq "ARRAY") {
376
if (@_ && ref($_[0]) eq "ARRAY") {
379
if (@_ && !ref($_[0])) {
381
&_validate_interface($interface);
383
if (@_ && ref($_[0]) eq "HASH") {
384
%attributes = %{$_[0]};
388
die "interface not specified & no default interface defined";
391
my $param_names = [];
392
if ( $attributes{param_names} ) {
393
$param_names = $attributes{param_names} if ref($attributes{param_names}) eq "ARRAY";
394
delete($attributes{param_names});
396
my $return_names = [];
397
if ( $attributes{return_names} ) {
398
$return_names = $attributes{return_names} if ref($attributes{return_names}) eq "ARRAY";
399
delete($attributes{return_names});
402
$dbus_exports{$caller}->{methods}->{$name} = [$params, $returns, $interface, \%attributes, $param_names, $return_names];
405
=item dbus_no_strict_exports();
407
If a object is using the Exporter to generate DBus introspection data,
408
the default behaviour is to only allow invocation of methods which have
409
been explicitly exported.
411
To allow clients to access methods which have not been explicitly
412
exported, call C<dbus_no_strict_exports>. NB, doing this may be
413
a security risk if you have methods considered to be "private" for
414
internal use only. As such this method should not normally be used.
415
It is here only to allow switching export behaviour to match earlier
420
sub dbus_no_strict_exports {
422
$dbus_exports{$caller}->{strict} = 0;
425
=item dbus_property($name, $type, $access, [\%attributes]);
427
=item dbus_property($name, $type, $access, $interface, [\%attributes]);
429
Exports a property called C<$name>, whose data type is C<$type>.
430
If the C<$interface> parameter is provided, then the property is
431
associated with that interface, otherwise the default interface
432
for the calling package is used.
439
my $access = "readwrite";
441
my $interface = $dbus_exports{$caller}->{interface};
444
if (@_ && (!ref($_[0]) || (ref($_[0]) eq "ARRAY"))) {
447
if (@_ && !ref($_[0])) {
450
if (@_ && !ref($_[0])) {
452
&_validate_interface($interface);
454
if ($_ && ref($_[0]) eq "HASH") {
455
%attributes = %{$_[0]};
459
die "interface not specified & no default interface defined";
462
$dbus_exports{$caller}->{props}->{$name} = [$type, $access, $interface, \%attributes];
466
=item dbus_signal($name, $params, [\%attributes]);
468
=item dbus_signal($name, $params, $interface, [\%attributes]);
470
Exports a signal called C<$name>, having parameters whose types
471
are defined by C<$params>. If the C<$interface> parameter is
472
provided, then the signal is associated with that interface, otherwise
473
the default interface for the calling package is used. The
474
value for the C<$params> parameter should be an array reference
475
with each element defining the data type of a parameter to the
476
signal. Signals do not have return values. It not possible to
477
export a signal which has a variable number of parameters.
485
my $interface = $dbus_exports{$caller}->{interface};
488
if (@_ && ref($_[0]) eq "ARRAY") {
491
if (@_ && !ref($_[0])) {
493
&_validate_interface($interface);
495
if (@_ && ref($_[0]) eq "HASH") {
496
%attributes = %{$_[0]};
500
die "interface not specified & no default interface defined";
503
my $param_names = [];
504
if ( $attributes{param_names} ) {
505
$param_names = $attributes{param_names} if ref($attributes{param_names}) eq "ARRAY";
506
delete($attributes{param_names});
509
$dbus_exports{$caller}->{signals}->{$name} = [$params, $interface, \%attributes, $param_names];
513
sub _validate_interface {
514
my $interface = shift;
516
die "interface name '$interface' is not valid.\n" .
517
" * Interface names are composed of 1 or more elements separated by a\n" .
518
" period ('.') character. All elements must contain at least one character.\n" .
519
" * Each element must only contain the ASCII characters '[A-Z][a-z][0-9]_'\n" .
520
" and must not begin with a digit.\n" .
521
" * Interface names must contain at least one '.' (period) character (and\n" .
522
" thus at least two elements).\n" .
523
" * Interface names must not begin with a '.' (period) character.\n"
524
unless $interface =~ /^[a-zA-Z_]\w*(\.[a-zA-Z_]\w*)+$/;
535
=item No paramters, no return values
537
A method which simply prints "Hello World" each time its called
541
print "Hello World\n";
544
dbus_method("Hello", [], []);
546
=item One string parameter, returning an boolean value
548
A method which accepts a process name, issues the killall
549
command on it, and returns a boolean value to indicate whether
554
my $processname = shift;
555
my $ret = system("killall $processname");
556
return $ret == 0 ? 1 : 0;
559
dbus_method("KillAll", ["string"], ["bool"]);
561
=item One list of strings parameter, returning a dictionary
563
A method which accepts a list of files names, stats them, and
564
returns a dictionary containing the last modification times.
571
foreach my $file (@{$files}) {
572
$mods{$file} = (stat $file)[9];
577
dbus_method("LastModified", ["array", "string"], ["dict", "string", "int32"]);
579
=item Annotating methods with metdata
581
A method which is targetted for removal, and also does not
588
system "mpg123 $track &";
591
dbus_method("PlayMP3", ["string"], [], { deprecated => 1, no_return => 1 });
593
Or giving names to input parameters:
599
system "mpg123 $track &";
602
dbus_method("PlayMP3", ["string"], [], { param_names => ["track"] });
608
Daniel P. Berrange <dan@berrange.com>
612
Copright (C) 2004-2011, Daniel Berrange.
616
L<Net::DBus::Object>, L<Net::DBus::Binding::Introspector>
added
removed
.pc/spelling-errors.patch/lib/Net/DBus/Exporter.pm
