ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-DBus/DBus.pm
(Generate patch)

Comparing AnyEvent-DBus/DBus.pm (file contents):
Revision 1.1 by root, Sun Jun 20 23:52:13 2010 UTC vs.
Revision 1.7 by root, Mon Jun 21 19:59:28 2010 UTC

1=head1 NAME 1=head1 NAME
2 2
3AnyEvent::AIO - truly asynchronous file and directory I/O 3AnyEvent::DBus - adapt Net::DBus to AnyEvent
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::DBus; 7 use AnyEvent::DBus;
8 8
9 # now use the Net::DBus API, preferably the non-blocking variants 9 # 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 (...);
10 21
11=head1 DESCRIPTION 22=head1 DESCRIPTION
12 23
13This module is an L<AnyEvent> user, you need to make sure that you use and 24This module is an L<AnyEvent> user, you need to make sure that you use and
14run a supported event loop. 25run a supported event loop.
… …
18hacking L<Net::DBus::Reactor> so that all dbus connections created after 29hacking L<Net::DBus::Reactor> so that all dbus connections created after
19loading this module will automatically be managed by this module. 30loading this module will automatically be managed by this module.
20 31
21Note that a) a lot inside Net::DBus is still blocking b) if you call a 32Note that a) a lot inside Net::DBus is still blocking b) if you call a
22method that blocks, you again block your process (basically anything 33method that blocks, you again block your process (basically anything
23but calls to the Net::DBus::Binding::Connection objects block, but 34but calls to the Net::DBus::Binding::Connection objects block, but see
24see Net::DBus::Annoation, specifically dbus_call_async) and c) this 35Net::DBus::Annoation, specifically dbus_call_async) c) the underlying
36libdbus is often blocking itself, even with infinite timeouts and d) this
25module only implements the minimum API required to make Net::DBus work - 37module only implements the minimum API required to make Net::DBus work -
26Net::DBus unfortunately has no nice hooking API. 38Net::DBus unfortunately has no nice hooking API.
27 39
28However, unlike L<Net::DBus::Reactor>, this module should be fully 40However, unlike L<Net::DBus::Reactor>, this module should be fully
29non-blocking as long as you only use non-blocking APIs (Net::DBus::Reactor 41non-blocking as long as you only use non-blocking APIs (Net::DBus::Reactor
30blocks on writes). 42blocks on writes). It should also be faster, but Net::DBus is such a
43morass so unneeded method calls that speed won't matter much...
44
45=head2 EXAMPLE
46
47Here is a simple example. Both work with AnyEvent::DBus and do the same
48thing, but only the second is actually non-blocking.
49
50Example 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
61Example 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;
31 84
32=cut 85=cut
33 86
34package AnyEvent::DBus; 87package AnyEvent::DBus;
35 88
… …
37 90
38use AnyEvent (); 91use AnyEvent ();
39use Net::DBus (); 92use Net::DBus ();
40use Net::DBus::Binding::Watch (); 93use Net::DBus::Binding::Watch ();
41 94
42our $VERSION = '0.1'; 95our $VERSION = '0.3';
43 96
44# yup, Net::DBus checks by using exists on %INC... 97# yup, Net::DBus checks by using exists on %INC...
45$INC{'Net/DBus/Reactor.pm'} = undef; 98$INC{'Net/DBus/Reactor.pm'} = undef;
46 99
47# claim we are the main reactor mainloop 100# claim we are the main reactor mainloop
… …
60 my $id = $w->get_data; 113 my $id = $w->get_data;
61 my $f = $w->get_flags; 114 my $f = $w->get_flags;
62 my $fd = $w->get_fileno; 115 my $fd = $w->get_fileno;
63 my $on = $w->is_enabled; 116 my $on = $w->is_enabled;
64 117
65 warn "io $id $on?$f\n";
66
67 $f & Net::DBus::Binding::Watch::READABLE () 118 $f & Net::DBus::Binding::Watch::READABLE ()
68 and 119 and
69 $O{$id}[0] = $on && AE::io $fd, 0, sub { 120 $O{$id}[0] = $on && AE::io $fd, 0, sub {
70 $w->handle (Net::DBus::Binding::Watch::READABLE ()); 121 $w->handle (Net::DBus::Binding::Watch::READABLE ());
71 $con->dispatch; # wtf., we tell it data is ready, but have to call dispatch ourselves??? 122 $con->dispatch;
72 }; 123 };
73 124
74 $f & Net::DBus::Binding::Watch::WRITABLE () 125 $f & Net::DBus::Binding::Watch::WRITABLE ()
75 and 126 and
76 $O{$id}[1] = $on && AE::io $fd, 1, sub { 127 $O{$id}[1] = $on && AE::io $fd, 1, sub {
77 $w->handle (Net::DBus::Binding::Watch::WRITABLE ()); 128 $w->handle (Net::DBus::Binding::Watch::WRITABLE ());
78 # calling flush, as NEt::DBus::Reactor does, is blocking :/ 129 $con->dispatch;
79 }; 130 };
80} 131}
81 132
82sub io_on { 133sub io_on {
83 my ($con, $w) = @_; 134 my ($con, $w) = @_;
… …
92 my ($con, $w) = @_; 143 my ($con, $w) = @_;
93 144
94 my $id = $w->get_data; 145 my $id = $w->get_data;
95 my $i = $w->get_interval * 0.001; 146 my $i = $w->get_interval * 0.001;
96 147
97 $O{$id} = $w->is_enabled && AE::timer $i, $i, sub { $w->handle }; 148 $O{$id} = $w->is_enabled && AE::timer $i, $i, sub {
149 $w->handle;
150 $con->dispatch;
151 };
98} 152}
99 153
100sub timeout_on { 154sub timeout_on {
101 my ($con, $w) = @_; 155 my ($con, $w) = @_;
102 my $id = ++$I; 156 my $id = ++$I;
… …
107 161
108sub manage { 162sub manage {
109 my (undef, $con) = @_; 163 my (undef, $con) = @_;
110 164
111 $con->set_watch_callbacks (\&io_on, \&watch_off, \&io_toggle); 165 $con->set_watch_callbacks (\&io_on, \&watch_off, \&io_toggle);
166# if $con->can ("set_watch_callbacks");
167
112 $con->set_timeout_callbacks (\&timeout_on, \&watch_off, \&timeout_toggle); 168 $con->set_timeout_callbacks (\&timeout_on, \&watch_off, \&timeout_toggle);
169# if $con->can ("set_timeout_callbacks");
170
171 $con->dispatch; # for good measure
113} 172}
114
115use Net::DBus::Annotation qw(:call);
116my $bus = Net::DBus->find;
117my $ob = $bus->get_bus_object;
118#my $res = $ob->ListNames (dbus_call_async, "x" x 8192000);
119my $res = $ob->ListNames (dbus_call_async);
120#Net::DBus::Binding::PendingCall
121$res->set_notify (sub {
122 warn "<@_>\n";#d#
123 for my $name (sort @{$_[0]->get_result}) {
124 print " ", $name, "\n";
125 }
126});
127AE::cv->recv;
128warn $ob;
129 173
130=head1 SEE ALSO 174=head1 SEE ALSO
131 175
132L<AnyEvent>, L<Net::DBus>. 176L<AnyEvent>, L<Net::DBus>.
133 177

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines