AnyEvent-DBus/DBus.pm

=head1 NAME

AnyEvent::DBus - adapt Net::DBus to AnyEvent

=head1 SYNOPSIS

   use AnyEvent::DBus;

   # now use the Net::DBus API, preferably the non-blocking variants:

   use Net::DBus::Annotation qw(:call);

   $bus->get_object (...)
       ->Method (dbus_call_async, $arg1, ...)
       ->set_notify (sub {
          my @data = $_[0]->get_result
          ...
       });

   $bus->get_connection->send (...);

=head1 DESCRIPTION

This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.

Loading this module will install the necessary magic to seamlessly
integrate L<Net::DBus> into L<AnyEvent>. It does this by quite brutally
hacking L<Net::DBus::Reactor> so that all dbus connections created after
loading this module will automatically be managed by this module.

Note that a) a lot inside Net::DBus is still blocking b) if you call a
method that blocks, you again block your process (basically anything
but calls to the Net::DBus::Binding::Connection objects block, but see
Net::DBus::Annoation, specifically dbus_call_async) c) the underlying
libdbus is often blocking itself, even with infinite timeouts and d) this
module only implements the minimum API required to make Net::DBus work -
Net::DBus unfortunately has no nice hooking API.

However, unlike L<Net::DBus::Reactor>, this module should be fully
non-blocking as long as you only use non-blocking APIs (Net::DBus::Reactor
blocks on writes). It should also be faster, but Net::DBus is such a
morass so unneeded method calls that speed won't matter much...

=head2 EXAMPLE

Here is a simple example. Both work with AnyEvent::DBus and do the same
thing, but only the second is actually non-blocking.

Example 1: list registered named, blocking version.

   use AnyEvent::DBus;

   my $conn = Net::DBus->find;
   my $bus  = $conn->get_bus_object;

   for my $name (@{ $bus->ListNames }) {
      print "  $name\n";
   }

Example 1: list registered named, somewhat non-blocking version.

   use AnyEvent;
   use AnyEvent::DBus;
   use Net::DBus::Annotation qw(:call);

   my $conn = Net::DBus->find; # always blocks :/
   my $bus  = $conn->get_bus_object;

   my $quit = AE::cv;

   # the trick here is to prepend dbus_call_async to any method
   # arguments and then to call the set_notify method on the
   # returned Net::DBus::AsyncReply object

   $bus->ListNames (dbus_call_async)->set_notify (sub {
      for my $name (@{ $_[0]->get_result }) {
         print "  $name\n";
      }
      $quit->send;
   });

   $quit->recv;

=cut

package AnyEvent::DBus;

use common::sense;

use AnyEvent ();
use Net::DBus ();
use Net::DBus::Binding::Watch ();

our $VERSION = '0.3';

# yup, Net::DBus checks by using exists on %INC...
$INC{'Net/DBus/Reactor.pm'} = undef;

# claim we are the main reactor mainloop
*Net::DBus::Reactor::main = sub { __PACKAGE__ };

our $I = 0;
our %O; # watchers and timers, unfortunately, dbus only supports attaching integers...

sub watch_off {
   delete $O{$_[1]->get_data};
}

sub io_toggle {
   my ($con, $w) = @_;

   my $id = $w->get_data;
   my $f  = $w->get_flags;
   my $fd = $w->get_fileno;
   my $on = $w->is_enabled;

   $f & Net::DBus::Binding::Watch::READABLE ()
      and
         $O{$id}[0] = $on && AE::io $fd, 0, sub {
            $w->handle (Net::DBus::Binding::Watch::READABLE ());
            $con->dispatch;
         };

   $f & Net::DBus::Binding::Watch::WRITABLE ()
      and
         $O{$id}[1] = $on && AE::io $fd, 1, sub {
            $w->handle (Net::DBus::Binding::Watch::WRITABLE ());
            $con->dispatch;
         };
}

sub io_on {
   my ($con, $w) = @_;

   my $id = ++$I;
   $w->set_data ($id);

   &io_toggle;
}

sub timeout_toggle {
   my ($con, $w) = @_;

   my $id = $w->get_data;
   my $i  = $w->get_interval * 0.001;

   $O{$id} = $w->is_enabled && AE::timer $i, $i, sub {
      $w->handle;
      $con->dispatch;
   };
}

sub timeout_on {
   my ($con, $w) = @_;
   my $id = ++$I;
   $w->set_data ($id);
   
   &timeout_toggle;
}

sub manage {
   my (undef, $con) = @_;

   $con->set_watch_callbacks (\&io_on, \&watch_off, \&io_toggle);
#      if $con->can ("set_watch_callbacks");

   $con->set_timeout_callbacks (\&timeout_on, \&watch_off, \&timeout_toggle);
#      if $con->can ("set_timeout_callbacks");

   $con->dispatch; # for good measure
}

=head1 SEE ALSO

L<AnyEvent>, L<Net::DBus>.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

1
Revision:	1.7
Committed:	Mon Jun 21 19:59:28 2010 UTC (13 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.6:	+6 -3 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.5	AnyEvent::DBus - adapt Net::DBus to AnyEvent
4	root	1.1
5			=head1 SYNOPSIS
6
7			use AnyEvent::DBus;
8
9	root	1.5	# now use the Net::DBus API, preferably the non-blocking variants:
10
11			use Net::DBus::Annotation qw(:call);
12
13			$bus->get_object (...)
14			->Method (dbus_call_async, $arg1, ...)
15			->set_notify (sub {
16			my @data = $_[0]->get_result
17			...
18			});
19
20			$bus->get_connection->send (...);
21	root	1.1
22			=head1 DESCRIPTION
23
24			This module is an L<AnyEvent> user, you need to make sure that you use and
25			run a supported event loop.
26
27			Loading this module will install the necessary magic to seamlessly
28			integrate L<Net::DBus> into L<AnyEvent>. It does this by quite brutally
29			hacking L<Net::DBus::Reactor> so that all dbus connections created after
30			loading this module will automatically be managed by this module.
31
32			Note that a) a lot inside Net::DBus is still blocking b) if you call a
33			method that blocks, you again block your process (basically anything
34	root	1.7	but calls to the Net::DBus::Binding::Connection objects block, but see
35			Net::DBus::Annoation, specifically dbus_call_async) c) the underlying
36			libdbus is often blocking itself, even with infinite timeouts and d) this
37	root	1.1	module only implements the minimum API required to make Net::DBus work -
38			Net::DBus unfortunately has no nice hooking API.
39
40			However, unlike L<Net::DBus::Reactor>, this module should be fully
41			non-blocking as long as you only use non-blocking APIs (Net::DBus::Reactor
42	root	1.2	blocks on writes). It should also be faster, but Net::DBus is such a
43	root	1.7	morass so unneeded method calls that speed won't matter much...
44	root	1.2
45			=head2 EXAMPLE
46
47			Here is a simple example. Both work with AnyEvent::DBus and do the same
48			thing, but only the second is actually non-blocking.
49
50			Example 1: list registered named, blocking version.
51
52			use AnyEvent::DBus;
53
54			my $conn = Net::DBus->find;
55			my $bus = $conn->get_bus_object;
56
57			for my $name (@{ $bus->ListNames }) {
58			print " $name\n";
59			}
60
61			Example 1: list registered named, somewhat non-blocking version.
62
63			use AnyEvent;
64			use AnyEvent::DBus;
65			use Net::DBus::Annotation qw(:call);
66
67			my $conn = Net::DBus->find; # always blocks :/
68			my $bus = $conn->get_bus_object;
69
70			my $quit = AE::cv;
71
72			# the trick here is to prepend dbus_call_async to any method
73			# arguments and then to call the set_notify method on the
74			# returned Net::DBus::AsyncReply object
75
76			$bus->ListNames (dbus_call_async)->set_notify (sub {
77			for my $name (@{ $_[0]->get_result }) {
78			print " $name\n";
79			}
80			$quit->send;
81			});
82
83			$quit->recv;
84	root	1.1
85			=cut
86
87			package AnyEvent::DBus;
88
89			use common::sense;
90
91			use AnyEvent ();
92			use Net::DBus ();
93			use Net::DBus::Binding::Watch ();
94
95	root	1.5	our $VERSION = '0.3';
96	root	1.1
97			# yup, Net::DBus checks by using exists on %INC...
98			$INC{'Net/DBus/Reactor.pm'} = undef;
99
100			# claim we are the main reactor mainloop
101			*Net::DBus::Reactor::main = sub { __PACKAGE__ };
102
103			our $I = 0;
104			our %O; # watchers and timers, unfortunately, dbus only supports attaching integers...
105
106			sub watch_off {
107			delete $O{$_[1]->get_data};
108			}
109
110			sub io_toggle {
111			my ($con, $w) = @_;
112
113			my $id = $w->get_data;
114			my $f = $w->get_flags;
115			my $fd = $w->get_fileno;
116			my $on = $w->is_enabled;
117
118			$f & Net::DBus::Binding::Watch::READABLE ()
119			and
120			$O{$id}[0] = $on && AE::io $fd, 0, sub {
121			$w->handle (Net::DBus::Binding::Watch::READABLE ());
122	root	1.6	$con->dispatch;
123	root	1.1	};
124
125			$f & Net::DBus::Binding::Watch::WRITABLE ()
126			and
127			$O{$id}[1] = $on && AE::io $fd, 1, sub {
128			$w->handle (Net::DBus::Binding::Watch::WRITABLE ());
129	root	1.6	$con->dispatch;
130	root	1.1	};
131			}
132
133			sub io_on {
134			my ($con, $w) = @_;
135
136			my $id = ++$I;
137			$w->set_data ($id);
138
139			&io_toggle;
140			}
141
142			sub timeout_toggle {
143			my ($con, $w) = @_;
144
145			my $id = $w->get_data;
146			my $i = $w->get_interval * 0.001;
147
148	root	1.6	$O{$id} = $w->is_enabled && AE::timer $i, $i, sub {
149			$w->handle;
150			$con->dispatch;
151			};
152	root	1.1	}
153
154			sub timeout_on {
155			my ($con, $w) = @_;
156			my $id = ++$I;
157			$w->set_data ($id);
158
159			&timeout_toggle;
160			}
161
162			sub manage {
163			my (undef, $con) = @_;
164
165	root	1.4	$con->set_watch_callbacks (\&io_on, \&watch_off, \&io_toggle);
166			# if $con->can ("set_watch_callbacks");
167	root	1.3
168	root	1.4	$con->set_timeout_callbacks (\&timeout_on, \&watch_off, \&timeout_toggle);
169			# if $con->can ("set_timeout_callbacks");
170	root	1.7
171			$con->dispatch; # for good measure
172	root	1.1	}
173
174			=head1 SEE ALSO
175
176			L<AnyEvent>, L<Net::DBus>.
177
178			=head1 AUTHOR
179
180			Marc Lehmann <schmorp@schmorp.de>
181			http://home.schmorp.de/
182
183			=cut
184
185			1